FBAAMST ;WCIOFO/SAB-MST REPORT ;6/12/2001
;;3.5;FEE BASIS;**30**;JAN 30, 1995
;
; locate POV for MST
S FBPOV=$$POV^FBAAUTL3("55")
I FBPOV'>0 D G EXIT
. W $C(7),!,"Purpose of Visit Code 55 (MST) not found. Can't print the MST report."
;
; ask dates
S DIR(0)="D^::EX",DIR("A")="From Date"
; default from date is first day of previous month
S DIR("B")=$$FMTE^XLFDT($E($$FMADD^XLFDT($E(DT,1,5)_"01",-1),1,5)_"01")
D ^DIR K DIR G:$D(DIRUT) EXIT
S FBDT1=Y
S DIR(0)="DA^"_FBDT1_"::EX",DIR("A")="To Date: "
; default to date is last day of specified month
S X=FBDT1 D DAYS^FBAAUTL1
S DIR("B")=$$FMTE^XLFDT($E(FBDT1,1,5)_X)
D ^DIR K DIR G:$D(DIRUT) EXIT
S FBDT2=Y
;
; ask if summary or detail
S DIR(0)="S^S:Summary;D:Detail"
S DIR("A")="Summary or Detail Output",DIR("B")="Summary"
S DIR("?",1)="Enter D to print veteran, authorization, and payment details."
S DIR("?",2)="Enter S to just print a report summary."
S DIR("?")="Enter a code from the list."
D ^DIR K DIR G:$D(DIRUT) EXIT
S FBDETAIL=$S(Y="D":1,1:0)
;
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^FBAAMST",ZTDESC="MST Report"
. F FBX="FBPOV","FBDT*","FBDETAIL" S ZTSAVE(FBX)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
QEN ; queued entry
U IO
;
GATHER ; collect and sort data
K ^TMP($J)
; initialize totals
F I="PATIENT","VISIT","AMTPAID" F J="F","M","U","T" S FBT(I,J)=0
;
S FBQUIT=0
; loop thru Fee Basis Patients
S FBC=0
S FBDFN=0 F S FBDFN=$O(^FBAAA(FBDFN)) Q:'FBDFN D Q:FBQUIT
. S FBC=FBC+1
. I $D(ZTQUEUED),FBC\1000,$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
. ;
. ; search for MST authoriztions that match criteron
. S FBFNDAUT=0 ; init flag, true if 1 or more MST authorizations
. ; loop thru authorizations
. S FBAU=0 F S FBAU=$O(^FBAAA(FBDFN,1,FBAU)) Q:'FBAU D
. . S FBA=$G(^FBAAA(FBDFN,1,FBAU,0))
. . Q:$P($G(^FBAAA(FBDFN,1,FBAU,"ADEL")),U) ; austin deleted
. . Q:$P(FBA,U,7)'=FBPOV ; not MST purpose of visit
. . ; ensure authorization is not outside the period of interest
. . Q:$P(FBA,U)>FBDT2 ; auth from date after specified rpt end
. . Q:$P(FBA,U,2)<FBDT1 ; auth to date before specified rpt begin
. . ; passed all criteria
. . I 'FBFNDAUT D
. . . ; this is the first MST authorization selected for patient
. . . ; get patient name
. . . S FBPNAME=$$GET1^DIQ(161,FBDFN,.01)
. . . S:FBPNAME="" FBPNAME="UNKNOWN"
. . . ; get gender
. . . S DFN=FBDFN K VAPTYP,VAHOW,VAROOT D DEM^VADPT
. . . S FBGEN=$P(VADM(5),U) ; gender internal value
. . . S FBSSN=$P(VADM(2),U,2) ; SSN external value
. . . I "^F^M^"'[(U_FBGEN_U) S FBGEN="U"
. . . ; increment count of unique patients
. . . S FBT("PATIENT",FBGEN)=FBT("PATIENT",FBGEN)+1
. . . S ^TMP($J,"FBA",FBPNAME_U_FBDFN)=FBSSN_U_FBGEN
. . . S FBFNDAUT=1 ; note that a MST authorization was found for patient
. . . D KVA^VADPT ; clean up patient demographics
. . ; save authorization by patient name^dfn,auth to date^auth ien
. . S ^TMP($J,"FBA",FBPNAME_U_FBDFN,$P(FBA,U,2)_U_FBAU)=FBA
. ;
. ; look for payments related to the selected patient authorizations
. Q:'FBFNDAUT ; no selected MST authorizations for patient
. ; loop thru vendor multiple
. S FBV=0 F S FBV=$O(^FBAAC(FBDFN,1,FBV)) Q:'FBV D
. . ; loop thru initial treatment date multiple
. . S FBTDI=0 F S FBTDI=$O(^FBAAC(FBDFN,1,FBV,1,FBTDI)) Q:'FBTDI D
. . . S FBY2=$G(^FBAAC(FBDFN,1,FBV,1,FBTDI,0))
. . . Q:$P(FBY2,U)<FBDT1 ; date of service prior to report start
. . . Q:$P(FBY2,U)>FBDT2 ; date of service after report end
. . . S FBATO=$P($G(^FBAAA(FBDFN,1,$P(FBY2,U,4),0)),U,2) ; auth to date
. . . Q:'$D(^TMP($J,"FBA",FBPNAME_U_FBDFN,FBATO_U_$P(FBY2,U,4))) ; not one of the selected authorizations
. . . ; loop thru service provided multiple
. . . S FBSPI=0
. . . F S FBSPI=$O(^FBAAC(FBDFN,1,FBV,1,FBTDI,1,FBSPI)) Q:'FBSPI D
. . . . S FBY3=$G(^FBAAC(FBDFN,1,FBV,1,FBTDI,1,FBSPI,0))
. . . . Q:$P(FBY3,U,6)="" ; not finalized
. . . . S ^TMP($J,"FBA",FBPNAME_U_FBDFN,FBATO_U_$P(FBY2,U,4),$P(FBY2,U)_U_FBSPI_","_FBTDI_","_FBV_","_FBDFN_",")=""
. . . . S FBT("AMTPAID",FBGEN)=FBT("AMTPAID",FBGEN)+$P(FBY3,U,3)
. . . . I '$D(^TMP($J,"FBV",FBDFN,$P(FBY2,U))) D
. . . . . ; new visit
. . . . . S FBT("VISIT",FBGEN)=FBT("VISIT",FBGEN)+1
. . . . . S ^TMP($J,"FBV",FBDFN,$P(FBY2,U))=""
;
PRINT ; report data
S FBPG=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
K FBDL S FBDL="",$P(FBDL,"-",IOM)=""
;
; build page header text for selection criteria
K FBHDT
S FBHDT(1)=" For "_$$FMTE^XLFDT(FBDT1)_" through "_$$FMTE^XLFDT(FBDT2)
;
;
D HD
I 'FBQUIT,'$D(^TMP($J)) W !,"No MST authorizations found during period."
I 'FBQUIT,FBDETAIL D
. ; loop thru veterans
. S FBPAT=""
. F S FBPAT=$O(^TMP($J,"FBA",FBPAT)) Q:FBPAT="" D Q:FBQUIT
. . S FBPNAME=$P(FBPAT,U)
. . S FBDFN=$P(FBPAT,U,2)
. . S FBX=$G(^TMP($J,"FBA",FBPAT))
. . W !!,FBPNAME,?40,"Patient ID: ",$P(FBX,U),?67,"Gender: ",$P(FBX,U,2)
. . ; loop thru authorizations
. . S FBAUT=""
. . F S FBAUT=$O(^TMP($J,"FBA",FBPAT,FBAUT)) Q:FBAUT="" D Q:FBQUIT
. . . S FBAU=$P(FBAUT,U,2)
. . . S FBA=^TMP($J,"FBA",FBPAT,FBAUT)
. . . I $Y+9>IOSL D HD Q:FBQUIT D HDPAT
. . . W !!,?2,"Authorization #: ",FBDFN,"-",FBAU
. . . W ?32,"FR: ",$$FMTE^XLFDT($P(FBA,U),"2DF")
. . . W ?47,"TO: ",$$FMTE^XLFDT($P(FBA,U,2),"2DF")
. . . ; loop thru payments
. . . I $O(^TMP($J,"FBA",FBPAT,FBAUT,""))']"" W !!,?4,"No finalized payments on file."
. . . E S FBPAY="" F S FBPAY=$O(^TMP($J,"FBA",FBPAT,FBAUT,FBPAY)) Q:FBPAY="" D Q:FBQUIT
. . . . S FBIENS=$P(FBPAY,U,2)
. . . . S FBV=$P(FBIENS,",",3)
. . . . S FBTDI=$P(FBIENS,",",2)
. . . . S FBSPI=$P(FBIENS,",",1)
. . . . S FBVY=$S(FBV:$G(^FBAAV(FBV,0)),1:"")
. . . . S FBAACPT=$$GET1^DIQ(162.03,FBIENS,.01)
. . . . S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_FBDFN_",1,"_FBV_",1,"_FBTDI_",1,"_FBSPI_",""M"")","E")
. . . . I $Y+7>IOSL D HD Q:FBQUIT D HDPAT,HDAUT
. . . . W !!,?4,"Svc Date: ",$$FMTE^XLFDT($P(FBPAY,U),"2DF")
. . . . W ?24,"CPT-MOD: "
. . . . W FBAACPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:"")
. . . . W ?43,"DIAG: ",$$GET1^DIQ(162.03,FBIENS,28)
. . . . W ?58,"AMT PAID: ",$J($$GET1^DIQ(162.03,FBIENS,2,"I"),9,2)
. . . . I $P($G(FBMODLE),",",2)]"" D Q:FBQUIT
. . . . . N FBI,FBMOD
. . . . . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D Q:FBQUIT
. . . . . . I $Y+4>IOSL D HD Q:FBQUIT D HDPAT,HDAUT
. . . . . . W !,?38,"-",FBMOD
. . . . W !,?4,"Vendor: ",$E($P(FBVY,U),1,30)
. . . . W ?44,"Vendor ID: ",$P(FBVY,U,2)
;
I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
E D RSUM
;
I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J)
K FBA,FBAACPT,FBATO,FBAU,FBAUT,FBC,FBDETAIL,FBDFN,FBDL,FBDT1,FBDT2
K FBDTR,FBFNDAUT,FBGEN,FBHDT,FBI,FBIENS,FBMODLE,FBPAT,FBPAY,FBPG
K FBPNAME,FBPOV,FBSPI,FBT,FBTDI,FBSSN,FBQUIT,FBV,FBVY,FBX,FBY2,FBY3
K %,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
Q
HD ; page header
N FBI
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
I $E(IOST,1,2)="C-"!FBPG W @IOF
S FBPG=FBPG+1
W !,"MST "_$S(FBDETAIL:"Detailed",1:"Summary")_" Report"
W ?49,FBDTR,?72,"page ",FBPG
S FBI=0 F S FBI=$O(FBHDT(FBI)) Q:'FBI W !,FBHDT(FBI)
W !,FBDL
Q
HDPAT ; page header for continued Patient
W !,"Patient: ",FBPNAME," (continued)"
Q
HDAUT ; page header for continued Authorization
W !," Authorization: ",FBDFN,"-",FBAU," (continued)"
Q
RSUM ; report summary
I $Y+14>IOSL D HD Q:FBQUIT
W !!,"REPORT SUMMARY"
W !!,"Gender",?8,"# Unique",?18,"# Visits"
W ?28," Total",?44,"Average Paid",?58,"Average Paid"
W !,?8,"Patients"
W ?28," Payments",?44," Per Patient",?58," Per Visit"
W !,"------",?8,"--------",?18,"--------"
W ?28,"--------------",?44,"------------",?58,"------------"
F I="F","M","U" D RSUML(I)
W !,?8,"--------",?18,"--------"
W ?28,"--------------",?44,"------------",?58,"------------"
D RSUML("T")
I $Y+8>IOSL D HD Q:FBQUIT
W !!,"Notes: (1) # Unique Patients represents patients having one or more MST"
W !," authorizations that overlap the period being reported."
W !," (2) # Visits and Total Payments are obtained from any finalized"
W !," payment(s) that are linked to the MST authorizations and have a"
W !," date of service within the period being reported."
Q
RSUML(FBI) ; report summary number line
N FBTX
S FBTX=$S(FBI="F":"Female",FBI="M":"Male",FBI="U":"Unspec.",1:"Total")
I FBI="U",FBT("PATIENT",FBI)'>0 Q
I "^F^M^U^"[(U_FBI_U) F I="PATIENT","VISIT","AMTPAID" S FBT(I,"T")=FBT(I,"T")+FBT(I,FBI)
W !,FBTX,?8,$J($FN(FBT("PATIENT",FBI),","),8)
W ?18,$J($FN(FBT("VISIT",FBI),","),8)
W ?28,$J($FN(FBT("AMTPAID",FBI),",",2),14)
I FBT("PATIENT",FBI)>0 W ?44,$J($FN(FBT("AMTPAID",FBI)/FBT("PATIENT",FBI),",",2),12)
I FBT("VISIT",FBI)>0 W ?58,$J($FN(FBT("AMTPAID",FBI)/FBT("VISIT",FBI),",",2),12)
Q
;
;FBAAMST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAMST 9139 printed Apr 09, 2024@21:02:25 Page 2
FBAAMST ;WCIOFO/SAB-MST REPORT ;6/12/2001
+1 ;;3.5;FEE BASIS;**30**;JAN 30, 1995
+2 ;
+3 ; locate POV for MST
+4 SET FBPOV=$$POV^FBAAUTL3("55")
+5 IF FBPOV'>0
Begin DoDot:1
+6 WRITE $CHAR(7),!,"Purpose of Visit Code 55 (MST) not found. Can't print the MST report."
End DoDot:1
GOTO EXIT
+7 ;
+8 ; ask dates
+9 SET DIR(0)="D^::EX"
SET DIR("A")="From Date"
+10 ; default from date is first day of previous month
+11 SET DIR("B")=$$FMTE^XLFDT($EXTRACT($$FMADD^XLFDT($EXTRACT(DT,1,5)_"01",-1),1,5)_"01")
+12 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+13 SET FBDT1=Y
+14 SET DIR(0)="DA^"_FBDT1_"::EX"
SET DIR("A")="To Date: "
+15 ; default to date is last day of specified month
+16 SET X=FBDT1
DO DAYS^FBAAUTL1
+17 SET DIR("B")=$$FMTE^XLFDT($EXTRACT(FBDT1,1,5)_X)
+18 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+19 SET FBDT2=Y
+20 ;
+21 ; ask if summary or detail
+22 SET DIR(0)="S^S:Summary;D:Detail"
+23 SET DIR("A")="Summary or Detail Output"
SET DIR("B")="Summary"
+24 SET DIR("?",1)="Enter D to print veteran, authorization, and payment details."
+25 SET DIR("?",2)="Enter S to just print a report summary."
+26 SET DIR("?")="Enter a code from the list."
+27 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+28 SET FBDETAIL=$SELECT(Y="D":1,1:0)
+29 ;
+30 ; ask device
+31 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+32 IF $DATA(IO("Q"))
Begin DoDot:1
+33 SET ZTRTN="QEN^FBAAMST"
SET ZTDESC="MST Report"
+34 FOR FBX="FBPOV","FBDT*","FBDETAIL"
SET ZTSAVE(FBX)=""
+35 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+36 ;
QEN ; queued entry
+1 USE IO
+2 ;
GATHER ; collect and sort data
+1 KILL ^TMP($JOB)
+2 ; initialize totals
+3 FOR I="PATIENT","VISIT","AMTPAID"
FOR J="F","M","U","T"
SET FBT(I,J)=0
+4 ;
+5 SET FBQUIT=0
+6 ; loop thru Fee Basis Patients
+7 SET FBC=0
+8 SET FBDFN=0
FOR
SET FBDFN=$ORDER(^FBAAA(FBDFN))
if 'FBDFN
QUIT
Begin DoDot:1
+9 SET FBC=FBC+1
+10 IF $DATA(ZTQUEUED)
IF FBC\1000
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+11 ;
+12 ; search for MST authoriztions that match criteron
+13 ; init flag, true if 1 or more MST authorizations
SET FBFNDAUT=0
+14 ; loop thru authorizations
+15 SET FBAU=0
FOR
SET FBAU=$ORDER(^FBAAA(FBDFN,1,FBAU))
if 'FBAU
QUIT
Begin DoDot:2
+16 SET FBA=$GET(^FBAAA(FBDFN,1,FBAU,0))
+17 ; austin deleted
if $PIECE($GET(^FBAAA(FBDFN,1,FBAU,"ADEL")),U)
QUIT
+18 ; not MST purpose of visit
if $PIECE(FBA,U,7)'=FBPOV
QUIT
+19 ; ensure authorization is not outside the period of interest
+20 ; auth from date after specified rpt end
if $PIECE(FBA,U)>FBDT2
QUIT
+21 ; auth to date before specified rpt begin
if $PIECE(FBA,U,2)<FBDT1
QUIT
+22 ; passed all criteria
+23 IF 'FBFNDAUT
Begin DoDot:3
+24 ; this is the first MST authorization selected for patient
+25 ; get patient name
+26 SET FBPNAME=$$GET1^DIQ(161,FBDFN,.01)
+27 if FBPNAME=""
SET FBPNAME="UNKNOWN"
+28 ; get gender
+29 SET DFN=FBDFN
KILL VAPTYP,VAHOW,VAROOT
DO DEM^VADPT
+30 ; gender internal value
SET FBGEN=$PIECE(VADM(5),U)
+31 ; SSN external value
SET FBSSN=$PIECE(VADM(2),U,2)
+32 IF "^F^M^"'[(U_FBGEN_U)
SET FBGEN="U"
+33 ; increment count of unique patients
+34 SET FBT("PATIENT",FBGEN)=FBT("PATIENT",FBGEN)+1
+35 SET ^TMP($JOB,"FBA",FBPNAME_U_FBDFN)=FBSSN_U_FBGEN
+36 ; note that a MST authorization was found for patient
SET FBFNDAUT=1
+37 ; clean up patient demographics
DO KVA^VADPT
End DoDot:3
+38 ; save authorization by patient name^dfn,auth to date^auth ien
+39 SET ^TMP($JOB,"FBA",FBPNAME_U_FBDFN,$PIECE(FBA,U,2)_U_FBAU)=FBA
End DoDot:2
+40 ;
+41 ; look for payments related to the selected patient authorizations
+42 ; no selected MST authorizations for patient
if 'FBFNDAUT
QUIT
+43 ; loop thru vendor multiple
+44 SET FBV=0
FOR
SET FBV=$ORDER(^FBAAC(FBDFN,1,FBV))
if 'FBV
QUIT
Begin DoDot:2
+45 ; loop thru initial treatment date multiple
+46 SET FBTDI=0
FOR
SET FBTDI=$ORDER(^FBAAC(FBDFN,1,FBV,1,FBTDI))
if 'FBTDI
QUIT
Begin DoDot:3
+47 SET FBY2=$GET(^FBAAC(FBDFN,1,FBV,1,FBTDI,0))
+48 ; date of service prior to report start
if $PIECE(FBY2,U)<FBDT1
QUIT
+49 ; date of service after report end
if $PIECE(FBY2,U)>FBDT2
QUIT
+50 ; auth to date
SET FBATO=$PIECE($GET(^FBAAA(FBDFN,1,$PIECE(FBY2,U,4),0)),U,2)
+51 ; not one of the selected authorizations
if '$DATA(^TMP($JOB,"FBA",FBPNAME_U_FBDFN,FBATO_U_$PIECE(FBY2,U,4)))
QUIT
+52 ; loop thru service provided multiple
+53 SET FBSPI=0
+54 FOR
SET FBSPI=$ORDER(^FBAAC(FBDFN,1,FBV,1,FBTDI,1,FBSPI))
if 'FBSPI
QUIT
Begin DoDot:4
+55 SET FBY3=$GET(^FBAAC(FBDFN,1,FBV,1,FBTDI,1,FBSPI,0))
+56 ; not finalized
if $PIECE(FBY3,U,6)=""
QUIT
+57 SET ^TMP($JOB,"FBA",FBPNAME_U_FBDFN,FBATO_U_$PIECE(FBY2,U,4),$PIECE(FBY2,U)_U_FBSPI_","_FBTDI_","_FBV_","_FBDFN_",")=""
+58 SET FBT("AMTPAID",FBGEN)=FBT("AMTPAID",FBGEN)+$PIECE(FBY3,U,3)
+59 IF '$DATA(^TMP($JOB,"FBV",FBDFN,$PIECE(FBY2,U)))
Begin DoDot:5
+60 ; new visit
+61 SET FBT("VISIT",FBGEN)=FBT("VISIT",FBGEN)+1
+62 SET ^TMP($JOB,"FBV",FBDFN,$PIECE(FBY2,U))=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
if FBQUIT
QUIT
+63 ;
PRINT ; report data
+1 SET FBPG=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET FBDTR=Y
+2 KILL FBDL
SET FBDL=""
SET $PIECE(FBDL,"-",IOM)=""
+3 ;
+4 ; build page header text for selection criteria
+5 KILL FBHDT
+6 SET FBHDT(1)=" For "_$$FMTE^XLFDT(FBDT1)_" through "_$$FMTE^XLFDT(FBDT2)
+7 ;
+8 ;
+9 DO HD
+10 IF 'FBQUIT
IF '$DATA(^TMP($JOB))
WRITE !,"No MST authorizations found during period."
+11 IF 'FBQUIT
IF FBDETAIL
Begin DoDot:1
+12 ; loop thru veterans
+13 SET FBPAT=""
+14 FOR
SET FBPAT=$ORDER(^TMP($JOB,"FBA",FBPAT))
if FBPAT=""
QUIT
Begin DoDot:2
+15 SET FBPNAME=$PIECE(FBPAT,U)
+16 SET FBDFN=$PIECE(FBPAT,U,2)
+17 SET FBX=$GET(^TMP($JOB,"FBA",FBPAT))
+18 WRITE !!,FBPNAME,?40,"Patient ID: ",$PIECE(FBX,U),?67,"Gender: ",$PIECE(FBX,U,2)
+19 ; loop thru authorizations
+20 SET FBAUT=""
+21 FOR
SET FBAUT=$ORDER(^TMP($JOB,"FBA",FBPAT,FBAUT))
if FBAUT=""
QUIT
Begin DoDot:3
+22 SET FBAU=$PIECE(FBAUT,U,2)
+23 SET FBA=^TMP($JOB,"FBA",FBPAT,FBAUT)
+24 IF $Y+9>IOSL
DO HD
if FBQUIT
QUIT
DO HDPAT
+25 WRITE !!,?2,"Authorization #: ",FBDFN,"-",FBAU
+26 WRITE ?32,"FR: ",$$FMTE^XLFDT($PIECE(FBA,U),"2DF")
+27 WRITE ?47,"TO: ",$$FMTE^XLFDT($PIECE(FBA,U,2),"2DF")
+28 ; loop thru payments
+29 IF $ORDER(^TMP($JOB,"FBA",FBPAT,FBAUT,""))']""
WRITE !!,?4,"No finalized payments on file."
+30 IF '$TEST
SET FBPAY=""
FOR
SET FBPAY=$ORDER(^TMP($JOB,"FBA",FBPAT,FBAUT,FBPAY))
if FBPAY=""
QUIT
Begin DoDot:4
+31 SET FBIENS=$PIECE(FBPAY,U,2)
+32 SET FBV=$PIECE(FBIENS,",",3)
+33 SET FBTDI=$PIECE(FBIENS,",",2)
+34 SET FBSPI=$PIECE(FBIENS,",",1)
+35 SET FBVY=$SELECT(FBV:$GET(^FBAAV(FBV,0)),1:"")
+36 SET FBAACPT=$$GET1^DIQ(162.03,FBIENS,.01)
+37 SET FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_FBDFN_",1,"_FBV_",1,"_FBTDI_",1,"_FBSPI_",""M"")","E")
+38 IF $Y+7>IOSL
DO HD
if FBQUIT
QUIT
DO HDPAT
DO HDAUT
+39 WRITE !!,?4,"Svc Date: ",$$FMTE^XLFDT($PIECE(FBPAY,U),"2DF")
+40 WRITE ?24,"CPT-MOD: "
+41 WRITE FBAACPT_$SELECT($GET(FBMODLE)]"":"-"_$PIECE(FBMODLE,","),1:"")
+42 WRITE ?43,"DIAG: ",$$GET1^DIQ(162.03,FBIENS,28)
+43 WRITE ?58,"AMT PAID: ",$JUSTIFY($$GET1^DIQ(162.03,FBIENS,2,"I"),9,2)
+44 IF $PIECE($GET(FBMODLE),",",2)]""
Begin DoDot:5
+45 NEW FBI,FBMOD
+46 FOR FBI=2:1
SET FBMOD=$PIECE(FBMODLE,",",FBI)
if FBMOD=""
QUIT
Begin DoDot:6
+47 IF $Y+4>IOSL
DO HD
if FBQUIT
QUIT
DO HDPAT
DO HDAUT
+48 WRITE !,?38,"-",FBMOD
End DoDot:6
if FBQUIT
QUIT
End DoDot:5
if FBQUIT
QUIT
+49 WRITE !,?4,"Vendor: ",$EXTRACT($PIECE(FBVY,U),1,30)
+50 WRITE ?44,"Vendor ID: ",$PIECE(FBVY,U,2)
End DoDot:4
if FBQUIT
QUIT
End DoDot:3
if FBQUIT
QUIT
End DoDot:2
if FBQUIT
QUIT
End DoDot:1
+51 ;
+52 IF FBQUIT
WRITE !!,"REPORT STOPPED AT USER REQUEST"
+53 IF '$TEST
DO RSUM
+54 ;
+55 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+56 DO ^%ZISC
+57 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB)
+3 KILL FBA,FBAACPT,FBATO,FBAU,FBAUT,FBC,FBDETAIL,FBDFN,FBDL,FBDT1,FBDT2
+4 KILL FBDTR,FBFNDAUT,FBGEN,FBHDT,FBI,FBIENS,FBMODLE,FBPAT,FBPAY,FBPG
+5 KILL FBPNAME,FBPOV,FBSPI,FBT,FBTDI,FBSSN,FBQUIT,FBV,FBVY,FBX,FBY2,FBY3
+6 KILL %,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
+7 QUIT
HD ; page header
+1 NEW FBI
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"
IF FBPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
QUIT
+4 IF $EXTRACT(IOST,1,2)="C-"!FBPG
WRITE @IOF
+5 SET FBPG=FBPG+1
+6 WRITE !,"MST "_$SELECT(FBDETAIL:"Detailed",1:"Summary")_" Report"
+7 WRITE ?49,FBDTR,?72,"page ",FBPG
+8 SET FBI=0
FOR
SET FBI=$ORDER(FBHDT(FBI))
if 'FBI
QUIT
WRITE !,FBHDT(FBI)
+9 WRITE !,FBDL
+10 QUIT
HDPAT ; page header for continued Patient
+1 WRITE !,"Patient: ",FBPNAME," (continued)"
+2 QUIT
HDAUT ; page header for continued Authorization
+1 WRITE !," Authorization: ",FBDFN,"-",FBAU," (continued)"
+2 QUIT
RSUM ; report summary
+1 IF $Y+14>IOSL
DO HD
if FBQUIT
QUIT
+2 WRITE !!,"REPORT SUMMARY"
+3 WRITE !!,"Gender",?8,"# Unique",?18,"# Visits"
+4 WRITE ?28," Total",?44,"Average Paid",?58,"Average Paid"
+5 WRITE !,?8,"Patients"
+6 WRITE ?28," Payments",?44," Per Patient",?58," Per Visit"
+7 WRITE !,"------",?8,"--------",?18,"--------"
+8 WRITE ?28,"--------------",?44,"------------",?58,"------------"
+9 FOR I="F","M","U"
DO RSUML(I)
+10 WRITE !,?8,"--------",?18,"--------"
+11 WRITE ?28,"--------------",?44,"------------",?58,"------------"
+12 DO RSUML("T")
+13 IF $Y+8>IOSL
DO HD
if FBQUIT
QUIT
+14 WRITE !!,"Notes: (1) # Unique Patients represents patients having one or more MST"
+15 WRITE !," authorizations that overlap the period being reported."
+16 WRITE !," (2) # Visits and Total Payments are obtained from any finalized"
+17 WRITE !," payment(s) that are linked to the MST authorizations and have a"
+18 WRITE !," date of service within the period being reported."
+19 QUIT
RSUML(FBI) ; report summary number line
+1 NEW FBTX
+2 SET FBTX=$SELECT(FBI="F":"Female",FBI="M":"Male",FBI="U":"Unspec.",1:"Total")
+3 IF FBI="U"
IF FBT("PATIENT",FBI)'>0
QUIT
+4 IF "^F^M^U^"[(U_FBI_U)
FOR I="PATIENT","VISIT","AMTPAID"
SET FBT(I,"T")=FBT(I,"T")+FBT(I,FBI)
+5 WRITE !,FBTX,?8,$JUSTIFY($FNUMBER(FBT("PATIENT",FBI),","),8)
+6 WRITE ?18,$JUSTIFY($FNUMBER(FBT("VISIT",FBI),","),8)
+7 WRITE ?28,$JUSTIFY($FNUMBER(FBT("AMTPAID",FBI),",",2),14)
+8 IF FBT("PATIENT",FBI)>0
WRITE ?44,$JUSTIFY($FNUMBER(FBT("AMTPAID",FBI)/FBT("PATIENT",FBI),",",2),12)
+9 IF FBT("VISIT",FBI)>0
WRITE ?58,$JUSTIFY($FNUMBER(FBT("AMTPAID",FBI)/FBT("VISIT",FBI),",",2),12)
+10 QUIT
+11 ;
+12 ;FBAAMST
