source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAMST.m@ 703

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

initial load of WorldVistAEHR

File size: 8.7 KB
RevLine 
[613]1FBAAMST ;WCIOFO/SAB-MST REPORT ;6/12/2001
2 ;;3.5;FEE BASIS;**30**;JAN 30, 1995
3 ;
4 ; locate POV for MST
5 S FBPOV=$$POV^FBAAUTL3("55")
6 I FBPOV'>0 D G EXIT
7 . W $C(7),!,"Purpose of Visit Code 55 (MST) not found. Can't print the MST report."
8 ;
9 ; ask dates
10 S DIR(0)="D^::EX",DIR("A")="From Date"
11 ; default from date is first day of previous month
12 S DIR("B")=$$FMTE^XLFDT($E($$FMADD^XLFDT($E(DT,1,5)_"01",-1),1,5)_"01")
13 D ^DIR K DIR G:$D(DIRUT) EXIT
14 S FBDT1=Y
15 S DIR(0)="DA^"_FBDT1_"::EX",DIR("A")="To Date: "
16 ; default to date is last day of specified month
17 S X=FBDT1 D DAYS^FBAAUTL1
18 S DIR("B")=$$FMTE^XLFDT($E(FBDT1,1,5)_X)
19 D ^DIR K DIR G:$D(DIRUT) EXIT
20 S FBDT2=Y
21 ;
22 ; ask if summary or detail
23 S DIR(0)="S^S:Summary;D:Detail"
24 S DIR("A")="Summary or Detail Output",DIR("B")="Summary"
25 S DIR("?",1)="Enter D to print veteran, authorization, and payment details."
26 S DIR("?",2)="Enter S to just print a report summary."
27 S DIR("?")="Enter a code from the list."
28 D ^DIR K DIR G:$D(DIRUT) EXIT
29 S FBDETAIL=$S(Y="D":1,1:0)
30 ;
31 ; ask device
32 S %ZIS="QM" D ^%ZIS G:POP EXIT
33 I $D(IO("Q")) D G EXIT
34 . S ZTRTN="QEN^FBAAMST",ZTDESC="MST Report"
35 . F FBX="FBPOV","FBDT*","FBDETAIL" S ZTSAVE(FBX)=""
36 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
37 ;
38QEN ; queued entry
39 U IO
40 ;
41GATHER ; collect and sort data
42 K ^TMP($J)
43 ; initialize totals
44 F I="PATIENT","VISIT","AMTPAID" F J="F","M","U","T" S FBT(I,J)=0
45 ;
46 S FBQUIT=0
47 ; loop thru Fee Basis Patients
48 S FBC=0
49 S FBDFN=0 F S FBDFN=$O(^FBAAA(FBDFN)) Q:'FBDFN D Q:FBQUIT
50 . S FBC=FBC+1
51 . I $D(ZTQUEUED),FBC\1000,$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
52 . ;
53 . ; search for MST authoriztions that match criteron
54 . S FBFNDAUT=0 ; init flag, true if 1 or more MST authorizations
55 . ; loop thru authorizations
56 . S FBAU=0 F S FBAU=$O(^FBAAA(FBDFN,1,FBAU)) Q:'FBAU D
57 . . S FBA=$G(^FBAAA(FBDFN,1,FBAU,0))
58 . . Q:$P($G(^FBAAA(FBDFN,1,FBAU,"ADEL")),U) ; austin deleted
59 . . Q:$P(FBA,U,7)'=FBPOV ; not MST purpose of visit
60 . . ; ensure authorization is not outside the period of interest
61 . . Q:$P(FBA,U)>FBDT2 ; auth from date after specified rpt end
62 . . Q:$P(FBA,U,2)<FBDT1 ; auth to date before specified rpt begin
63 . . ; passed all criteria
64 . . I 'FBFNDAUT D
65 . . . ; this is the first MST authorization selected for patient
66 . . . ; get patient name
67 . . . S FBPNAME=$$GET1^DIQ(161,FBDFN,.01)
68 . . . S:FBPNAME="" FBPNAME="UNKNOWN"
69 . . . ; get gender
70 . . . S DFN=FBDFN K VAPTYP,VAHOW,VAROOT D DEM^VADPT
71 . . . S FBGEN=$P(VADM(5),U) ; gender internal value
72 . . . S FBSSN=$P(VADM(2),U,2) ; SSN external value
73 . . . I "^F^M^"'[(U_FBGEN_U) S FBGEN="U"
74 . . . ; increment count of unique patients
75 . . . S FBT("PATIENT",FBGEN)=FBT("PATIENT",FBGEN)+1
76 . . . S ^TMP($J,"FBA",FBPNAME_U_FBDFN)=FBSSN_U_FBGEN
77 . . . S FBFNDAUT=1 ; note that a MST authorization was found for patient
78 . . . D KVA^VADPT ; clean up patient demographics
79 . . ; save authorization by patient name^dfn,auth to date^auth ien
80 . . S ^TMP($J,"FBA",FBPNAME_U_FBDFN,$P(FBA,U,2)_U_FBAU)=FBA
81 . ;
82 . ; look for payments related to the selected patient authorizations
83 . Q:'FBFNDAUT ; no selected MST authorizations for patient
84 . ; loop thru vendor multiple
85 . S FBV=0 F S FBV=$O(^FBAAC(FBDFN,1,FBV)) Q:'FBV D
86 . . ; loop thru initial treatment date multiple
87 . . S FBTDI=0 F S FBTDI=$O(^FBAAC(FBDFN,1,FBV,1,FBTDI)) Q:'FBTDI D
88 . . . S FBY2=$G(^FBAAC(FBDFN,1,FBV,1,FBTDI,0))
89 . . . Q:$P(FBY2,U)<FBDT1 ; date of service prior to report start
90 . . . Q:$P(FBY2,U)>FBDT2 ; date of service after report end
91 . . . S FBATO=$P($G(^FBAAA(FBDFN,1,$P(FBY2,U,4),0)),U,2) ; auth to date
92 . . . Q:'$D(^TMP($J,"FBA",FBPNAME_U_FBDFN,FBATO_U_$P(FBY2,U,4))) ; not one of the selected authorizations
93 . . . ; loop thru service provided multiple
94 . . . S FBSPI=0
95 . . . F S FBSPI=$O(^FBAAC(FBDFN,1,FBV,1,FBTDI,1,FBSPI)) Q:'FBSPI D
96 . . . . S FBY3=$G(^FBAAC(FBDFN,1,FBV,1,FBTDI,1,FBSPI,0))
97 . . . . Q:$P(FBY3,U,6)="" ; not finalized
98 . . . . S ^TMP($J,"FBA",FBPNAME_U_FBDFN,FBATO_U_$P(FBY2,U,4),$P(FBY2,U)_U_FBSPI_","_FBTDI_","_FBV_","_FBDFN_",")=""
99 . . . . S FBT("AMTPAID",FBGEN)=FBT("AMTPAID",FBGEN)+$P(FBY3,U,3)
100 . . . . I '$D(^TMP($J,"FBV",FBDFN,$P(FBY2,U))) D
101 . . . . . ; new visit
102 . . . . . S FBT("VISIT",FBGEN)=FBT("VISIT",FBGEN)+1
103 . . . . . S ^TMP($J,"FBV",FBDFN,$P(FBY2,U))=""
104 ;
105PRINT ; report data
106 S FBPG=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
107 K FBDL S FBDL="",$P(FBDL,"-",IOM)=""
108 ;
109 ; build page header text for selection criteria
110 K FBHDT
111 S FBHDT(1)=" For "_$$FMTE^XLFDT(FBDT1)_" through "_$$FMTE^XLFDT(FBDT2)
112 ;
113 ;
114 D HD
115 I 'FBQUIT,'$D(^TMP($J)) W !,"No MST authorizations found during period."
116 I 'FBQUIT,FBDETAIL D
117 . ; loop thru veterans
118 . S FBPAT=""
119 . F S FBPAT=$O(^TMP($J,"FBA",FBPAT)) Q:FBPAT="" D Q:FBQUIT
120 . . S FBPNAME=$P(FBPAT,U)
121 . . S FBDFN=$P(FBPAT,U,2)
122 . . S FBX=$G(^TMP($J,"FBA",FBPAT))
123 . . W !!,FBPNAME,?40,"Patient ID: ",$P(FBX,U),?67,"Gender: ",$P(FBX,U,2)
124 . . ; loop thru authorizations
125 . . S FBAUT=""
126 . . F S FBAUT=$O(^TMP($J,"FBA",FBPAT,FBAUT)) Q:FBAUT="" D Q:FBQUIT
127 . . . S FBAU=$P(FBAUT,U,2)
128 . . . S FBA=^TMP($J,"FBA",FBPAT,FBAUT)
129 . . . I $Y+9>IOSL D HD Q:FBQUIT D HDPAT
130 . . . W !!,?2,"Authorization #: ",FBDFN,"-",FBAU
131 . . . W ?32,"FR: ",$$FMTE^XLFDT($P(FBA,U),"2DF")
132 . . . W ?47,"TO: ",$$FMTE^XLFDT($P(FBA,U,2),"2DF")
133 . . . ; loop thru payments
134 . . . I $O(^TMP($J,"FBA",FBPAT,FBAUT,""))']"" W !!,?4,"No finalized payments on file."
135 . . . E S FBPAY="" F S FBPAY=$O(^TMP($J,"FBA",FBPAT,FBAUT,FBPAY)) Q:FBPAY="" D Q:FBQUIT
136 . . . . S FBIENS=$P(FBPAY,U,2)
137 . . . . S FBV=$P(FBIENS,",",3)
138 . . . . S FBTDI=$P(FBIENS,",",2)
139 . . . . S FBSPI=$P(FBIENS,",",1)
140 . . . . S FBVY=$S(FBV:$G(^FBAAV(FBV,0)),1:"")
141 . . . . S FBAACPT=$$GET1^DIQ(162.03,FBIENS,.01)
142 . . . . S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_FBDFN_",1,"_FBV_",1,"_FBTDI_",1,"_FBSPI_",""M"")","E")
143 . . . . I $Y+7>IOSL D HD Q:FBQUIT D HDPAT,HDAUT
144 . . . . W !!,?4,"Svc Date: ",$$FMTE^XLFDT($P(FBPAY,U),"2DF")
145 . . . . W ?24,"CPT-MOD: "
146 . . . . W FBAACPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:"")
147 . . . . W ?43,"DIAG: ",$$GET1^DIQ(162.03,FBIENS,28)
148 . . . . W ?58,"AMT PAID: ",$J($$GET1^DIQ(162.03,FBIENS,2,"I"),9,2)
149 . . . . I $P($G(FBMODLE),",",2)]"" D Q:FBQUIT
150 . . . . . N FBI,FBMOD
151 . . . . . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D Q:FBQUIT
152 . . . . . . I $Y+4>IOSL D HD Q:FBQUIT D HDPAT,HDAUT
153 . . . . . . W !,?38,"-",FBMOD
154 . . . . W !,?4,"Vendor: ",$E($P(FBVY,U),1,30)
155 . . . . W ?44,"Vendor ID: ",$P(FBVY,U,2)
156 ;
157 I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
158 E D RSUM
159 ;
160 I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
161 D ^%ZISC
162 ;
163EXIT ;
164 I $D(ZTQUEUED) S ZTREQ="@"
165 K ^TMP($J)
166 K FBA,FBAACPT,FBATO,FBAU,FBAUT,FBC,FBDETAIL,FBDFN,FBDL,FBDT1,FBDT2
167 K FBDTR,FBFNDAUT,FBGEN,FBHDT,FBI,FBIENS,FBMODLE,FBPAT,FBPAY,FBPG
168 K FBPNAME,FBPOV,FBSPI,FBT,FBTDI,FBSSN,FBQUIT,FBV,FBVY,FBX,FBY2,FBY3
169 K %,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
170 Q
171HD ; page header
172 N FBI
173 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
174 I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
175 I $E(IOST,1,2)="C-"!FBPG W @IOF
176 S FBPG=FBPG+1
177 W !,"MST "_$S(FBDETAIL:"Detailed",1:"Summary")_" Report"
178 W ?49,FBDTR,?72,"page ",FBPG
179 S FBI=0 F S FBI=$O(FBHDT(FBI)) Q:'FBI W !,FBHDT(FBI)
180 W !,FBDL
181 Q
182HDPAT ; page header for continued Patient
183 W !,"Patient: ",FBPNAME," (continued)"
184 Q
185HDAUT ; page header for continued Authorization
186 W !," Authorization: ",FBDFN,"-",FBAU," (continued)"
187 Q
188RSUM ; report summary
189 I $Y+14>IOSL D HD Q:FBQUIT
190 W !!,"REPORT SUMMARY"
191 W !!,"Gender",?8,"# Unique",?18,"# Visits"
192 W ?28," Total",?44,"Average Paid",?58,"Average Paid"
193 W !,?8,"Patients"
194 W ?28," Payments",?44," Per Patient",?58," Per Visit"
195 W !,"------",?8,"--------",?18,"--------"
196 W ?28,"--------------",?44,"------------",?58,"------------"
197 F I="F","M","U" D RSUML(I)
198 W !,?8,"--------",?18,"--------"
199 W ?28,"--------------",?44,"------------",?58,"------------"
200 D RSUML("T")
201 I $Y+8>IOSL D HD Q:FBQUIT
202 W !!,"Notes: (1) # Unique Patients represents patients having one or more MST"
203 W !," authorizations that overlap the period being reported."
204 W !," (2) # Visits and Total Payments are obtained from any finalized"
205 W !," payment(s) that are linked to the MST authorizations and have a"
206 W !," date of service within the period being reported."
207 Q
208RSUML(FBI) ; report summary number line
209 N FBTX
210 S FBTX=$S(FBI="F":"Female",FBI="M":"Male",FBI="U":"Unspec.",1:"Total")
211 I FBI="U",FBT("PATIENT",FBI)'>0 Q
212 I "^F^M^U^"[(U_FBI_U) F I="PATIENT","VISIT","AMTPAID" S FBT(I,"T")=FBT(I,"T")+FBT(I,FBI)
213 W !,FBTX,?8,$J($FN(FBT("PATIENT",FBI),","),8)
214 W ?18,$J($FN(FBT("VISIT",FBI),","),8)
215 W ?28,$J($FN(FBT("AMTPAID",FBI),",",2),14)
216 I FBT("PATIENT",FBI)>0 W ?44,$J($FN(FBT("AMTPAID",FBI)/FBT("PATIENT",FBI),",",2),12)
217 I FBT("VISIT",FBI)>0 W ?58,$J($FN(FBT("AMTPAID",FBI)/FBT("VISIT",FBI),",",2),12)
218 Q
219 ;
220 ;FBAAMST
Note: See TracBrowser for help on using the repository browser.