source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRON.m@ 632

Last change on this file since 632 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1IBCRON ;ALB/ARH - RATES: REPORTS PROVIDER DISCOUNT ; 10-OCT-98
2 ;;2.0;INTEGRATED BILLING;**106,148**;21-MAR-94
3 ;
4EN ;get parameters then run the report
5 D HOME^%ZIS N DIR,X,Y,IBRPT,IBSRT W !!
6 S DIR("?")="Enter 'Y' for a list of all Providers in a discount group. Enter 'N' for a list of discount groups."
7 S DIR(0)="YO",DIR("A")="Print report by Provider",DIR("B")="NO" D ^DIR K DIR I $D(DIRUT) G EXIT
8 S IBRPT=Y
9 ;
10 I +IBRPT S DIR(0)="SO^1:Provider Type;2:Provider Name",DIR("A")="Sort Report By" D ^DIR K DIR I $D(DIRUT) G EXIT
11 S IBSRT=+Y
12 ;
13 ;
14DEV ;get the device
15 W !!,"Report requires 132 columns."
16 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
17 I $D(IO("Q")) S ZTRTN="RPT^IBCRON",ZTSAVE("IB*")="",ZTDESC="IB Provider Discount List" D ^%ZTLOAD K IO("Q") G EXIT
18 U IO
19 ;
20RPT ;find, save, and print the data that satisfies the search parameters
21 ;entry point for tasked jobs
22 ;
23 K ^TMP($J,"IBCRON")
24 ;
25 I 'IBRPT D SORT,PRINT
26 I +IBRPT,+IBSRT D SORT2,PRINT2
27 ;
28EXIT ;clean up and quit
29 K ^TMP($J,"IBCRON") Q:$D(ZTQUEUED)
30 D ^%ZISC
31 Q
32 ;
33SORT ;save the data in sorted order in a temporary file, sort by Special Group Name then Provider Type Name
34 N IBPD0,IBPDFN,IBPDN,IBSGFN,IBSGN,IBPCFN,IBPCVA
35 ;
36 S IBPDFN=0 F S IBPDFN=$O(^IBE(363.34,IBPDFN)) Q:'IBPDFN D
37 . S IBPD0=$G(^IBE(363.34,+IBPDFN,0)),IBPDN=$P(IBPD0,U,1)_" "
38 . S IBSGFN=+$P(IBPD0,U,2),IBSGN=$P($G(^IBE(363.32,+IBSGFN,0)),U,1)_" "
39 . S ^TMP($J,"IBCRON",IBSGN)=IBSGFN
40 . S ^TMP($J,"IBCRON",IBSGN,IBPDN,IBPDFN)=""
41 . ;
42 . S IBPCFN=0 F S IBPCFN=$O(^IBE(363.34,IBPDFN,11,"B",IBPCFN)) Q:'IBPCFN D
43 .. S IBPCVA=$$IEN2CODE^XUA4A72(IBPCFN),IBPCVA=IBPCVA_" "
44 .. S ^TMP($J,"IBCRON",IBSGN,IBPDN,IBPDFN,IBPCVA,IBPCFN)=""
45 Q
46 ;
47PRINT ;print the report from the temp sort file to the appropriate device
48 N IBPGN,IBLN,IBQUIT,IBSGN,IBSG0,IBPDN,IBPDFN,IBPD0,IBPCFN,IBPC0,IBL,IBT,IBI,X,Y,IBPCVA
49 S IBPGN=0,IBQUIT=0 D HDR Q:IBQUIT
50 ;
51 S IBSGN="" F S IBSGN=$O(^TMP($J,"IBCRON",IBSGN)) Q:IBSGN="" D Q:$$LNCHK(7)
52 . S IBSG0=^TMP($J,"IBCRON",IBSGN),IBSG0=$G(^IBE(363.32,+IBSG0,0))
53 . ;
54 . S IBL=$L("GROUP: "_$P(IBSG0,U,1)),IBT=(IOM-IBL)\2
55 . W !!,?IBT,"GROUP: ",$P(IBSG0,U,1),!,?IBT S IBLN=IBLN+2
56 . S IBI="",$P(IBI,"-",IBL+1)="" W IBI
57 . ;
58 . S IBPDN="" F S IBPDN=$O(^TMP($J,"IBCRON",IBSGN,IBPDN)) Q:IBPDN="" D Q:IBQUIT
59 .. S IBPDFN=0 F S IBPDFN=$O(^TMP($J,"IBCRON",IBSGN,IBPDN,IBPDFN)) Q:'IBPDFN D Q:$$LNCHK(4)
60 ... S IBPD0=$G(^IBE(363.34,+IBPDFN,0))
61 ... ;
62 ... W !!,$E($P(IBPD0,U,1),1,30),?35,$S($P(IBPD0,U,3)'="":$J(+$P(IBPD0,U,3),6)_"%",1:""),! S IBLN=IBLN+3
63 ... ;
64 ... S IBPCVA="" F S IBPCVA=$O(^TMP($J,"IBCRON",IBSGN,IBPDN,IBPDFN,IBPCVA)) Q:IBPCVA="" D Q:$$LNCHK(2)
65 .... S IBPCFN=0 F S IBPCFN=$O(^TMP($J,"IBCRON",IBSGN,IBPDN,IBPDFN,IBPCVA,IBPCFN)) Q:'IBPCFN D
66 ..... S IBPC0=$$CODE2TXT^XUA4A72(IBPCFN)
67 ..... ;
68 ..... W !,?5,IBPCVA,?16,$E($P(IBPC0,U,1),1,38),?56,$E($P(IBPC0,U,2),1,37),?95,$E($P(IBPC0,U,3),1,36) S IBLN=IBLN+1
69 ;
70 I 'IBQUIT D PAUSE
71 Q
72LNCHK(LNS) ; check if new page is needed
73 I 'IBQUIT,IBLN>(IOSL-LNS) D PAUSE I 'IBQUIT D HDR
74 Q IBQUIT
75 ;
76HDR ;print the report header
77 N IBNOW,IBI
78 S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
79 S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT),IBNOW=$P(IBNOW,"@",1)_" "_$P($P(IBNOW,"@",2),":",1,2)
80 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
81 ;
82 W !,"BILLING PROVIDER DISCOUNT LIST",?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN,!
83 W !,"PROVIDER TYPE",?36,"PERCENT",!,?5,"VA Code",?16,"Occupation",?56,"Specialty",?95,"Subspecialty",!
84 S IBI="",$P(IBI,"-",IOM+1)="" W IBI
85 Q
86 ;
87PAUSE ;pause at end of screen if beeing displayed on a terminal
88 Q:$E(IOST,1,2)'["C-" N DIR,DUOUT,DTOUT,DIRUT W !
89 S DIR(0)="E" D ^DIR K DIR
90 I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
91 Q
92 ;
93STOP() ;determine if user has requested the queued report to stop
94 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
95 Q +$G(ZTSTOP)
96 ;
97 ;
98 ;
99SORT2 ;save the data in sorted order in a temporary file, sort by Special Group Name then Provider Type Name
100 N IBPRV,IBNM,IBPC,IBPDFN,IBPD0,IBPDNM,IBPDSG,IBCNT S IBCNT=0
101 ;
102 S IBPRV=0 F S IBPRV=$O(^VA(200,IBPRV)) Q:'IBPRV D
103 . S IBNM=$P($G(^VA(200,IBPRV,0)),U,1)
104 . S IBPC=$$GET^XUA4A72(IBPRV)
105 . ;
106 . S IBPDFN=0 F S IBPDFN=$O(^IBE(363.34,"D",+IBPC,IBPDFN)) Q:'IBPDFN D
107 .. S IBPD0=$G(^IBE(363.34,IBPDFN,0)),IBPDNM=$P(IBPD0,U,1),IBPDSG=$P(IBPD0,U,2)
108 .. S IBCNT=IBCNT+1
109 .. ;
110 .. S ^TMP($J,"IBCRON",IBCNT)=IBNM_U_IBPDFN_U_IBPC
111 .. ;
112 .. I IBSRT=1 S ^TMP($J,"IBCRON","B",IBPDSG,IBPDNM,IBNM)=IBCNT Q
113 .. I IBSRT=2 S ^TMP($J,"IBCRON","B",IBPDSG,IBNM,IBPDNM)=IBCNT Q
114 Q
115 ;
116PRINT2 ;print the report from the temp sort file to the appropriate device
117 N IBPGN,IBLN,IBQUIT,IBPDSG,IBS1,IBS2,IBTMP,IBLNI,IBPDP,X,Y
118 S IBPGN=0,IBQUIT=0
119 ;
120 S IBPDSG=0 F S IBPDSG=$O(^TMP($J,"IBCRON","B",IBPDSG)) Q:'IBPDSG D HDR2 D Q:IBQUIT D PAUSE
121 . S IBS1="" F S IBS1=$O(^TMP($J,"IBCRON","B",IBPDSG,IBS1)) Q:IBS1="" D Q:$$LNCHK(2)
122 .. S IBS2="" F S IBS2=$O(^TMP($J,"IBCRON","B",IBPDSG,IBS1,IBS2)) Q:IBS2="" D Q:$$LNCHK(2)
123 ... S IBTMP=$G(^TMP($J,"IBCRON","B",IBPDSG,IBS1,IBS2)) Q:'IBTMP
124 ... S IBLNI=$G(^TMP($J,"IBCRON",IBTMP)) Q:IBLNI=""
125 ... S IBPDP=$P($G(^IBE(363.34,$P(IBLNI,U,2),0)),U,3),IBPDP=$S(IBPDP'="":IBPDP_"%",1:"")
126 ... ;
127 ... W !,$E(IBS1,1,21),?25,$E(IBS2,1,21),?47,$J(IBPDP,4) S IBLN=IBLN+1
128 ... W ?53,$P(IBLNI,U,9),?62,$E($P(IBLNI,U,4),1,22),?85,$E($P(IBLNI,U,5),1,22),?110,$E($P(IBLNI,U,6),1,22)
129 ;
130 Q
131 ;
132HDR2 ;print the report header
133 N IBNOW,IBI
134 S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
135 S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT),IBNOW=$P(IBNOW,"@",1)_" "_$P($P(IBNOW,"@",2),":",1,2)
136 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
137 ;
138 W !,"BILLING PROVIDER DISCOUNT LIST FOR PROVIDERS",?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN
139 W !,"SPECIAL GROUP: ",$P($G(^IBE(363.32,+$G(IBPDSG),0)),U,1),?53,"PERSON CLASS:"
140 I IBSRT=1 W !,"PROVIDER TYPE",?25,"PROVIDER"
141 I IBSRT=2 W !,"PROVIDER",?25,"PROVIDER TYPE"
142 W ?49,"%",?53,"VA Code",?66,"Occupation",?88,"Specialty",?110,"Subspecialty",!
143 S IBI="",$P(IBI,"-",IOM+1)="" W IBI
144 Q
Note: See TracBrowser for help on using the repository browser.