VistA-FOIAVistA/r/FEE_BASIS-FB/FBAAMST.m

221 lines
8.7 KiB
Mathematica

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