FBSHRAD ;WCIOFO/SAB-REPORT ACTIVE AUTHORIZATIONS FOR DATE ;2/9/1999
;;3.5;FEE BASIS;**13**;JAN 30, 1995
;
; ask program
S DIC="^FBAA(161.8,",DIC(0)="AQEM",DIC("B")="STATE HOME"
D ^DIC K DIC I Y'>0 G EXIT
S FBPROG=+Y
;
; ask purpose of visit(s)
S DIR(0)="Y",DIR("A")="For ALL Purpose of Visits? Y/N",DIR("B")="YES"
D ^DIR K DIR G:$D(DIRUT) EXIT
S FBPOV=Y
I 'FBPOV D G:'$D(FBPOV) EXIT S FBPOV=0
. K FBPOV
. W !,"Select one or more Purpose of Visits"
. S DIC="^FBAA(161.82,",DIC(0)="AQEM",DIC("S")="I $P(^(0),U,2)=FBPROG"
. F D Q:Y'>0
. . D ^DIC I Y>0 S FBPOV(+Y)=$P(Y,U,2)
. K DIC
;
; 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 remarks should be printed
S DIR(0)="Y",DIR("A")="Print authorization remarks",DIR("B")="NO"
D ^DIR K DIR G:$D(DIRUT) EXIT
S FBAR=Y
;
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^FBSHRAD",ZTDESC="Active Authorizations Report"
. F FBX="FBPROG","FBPOV*","FBDT*","FBAR" S ZTSAVE(FBX)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
QEN ; queued entry
U IO
;
GATHER ; collect and sort data
K ^TMP($J)
; loop thru Fee Basis Patients
S FBDFN=0 F S FBDFN=$O(^FBAAA(FBDFN)) Q:'FBDFN D
. S FBPNAME=$$GET1^DIQ(161,FBDFN,.01)
. S:FBPNAME="" FBPNAME="UNKNOWN"
. ; 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(FBA,U,3)'=FBPROG ; not program
. . Q:$P($G(^FBAAA(FBDFN,1,FBAU,"ADEL")),U) ; austin deleted
. . Q:$P(FBA,U,7)="" ; blank purpose of visit
. . I 'FBPOV Q:'$D(FBPOV($P(FBA,U,7))) ; not selected POV
. . ; 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
. . S FBVN=$S($P(FBA,U,4):$P($G(^FBAAV($P(FBA,U,4),0)),U),1:"")
. . I FBVN="" S FBVN="not specified"
. . ; sort by purpose of visit,vendor,name^dfn,auth from date^auth ien
. . S ^TMP($J,$P(FBA,U,7),FBVN,FBPNAME_U_FBDFN,$P(FBA,U)_U_FBAU)=FBA
;
PRINT ; report data
S (FBQUIT,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)=" FROM "_$$FMTE^XLFDT(FBDT1)_" TO "_$$FMTE^XLFDT(FBDT2)
S FBHDT(1)=FBHDT(1)_" FOR THE "_$$GET1^DIQ(161.8,FBPROG,.01)_" PROGRAM"
S FBHDT(2)=" FOR "_$S(FBPOV:"ALL ",1:"")_"PURPOSE OF VISIT(S)"
I 'FBPOV D
. S FBL=2,FBHDT(FBL)=FBHDT(FBL)_": "
. S (FBC,FBI)=0 F S FBI=$O(FBPOV(FBI)) Q:'FBI D
. . I $L(FBHDT(FBL))+2+$L(FBPOV(FBI))>75 D
. . . I FBC S FBHDT(FBL)=FBHDT(FBL)_","
. . . S FBL=FBL+1
. . . S FBC=0,FBHDT(FBL)=" "
. . S FBHDT(FBL)=FBHDT(FBL)_$S(FBC:", ",1:"")_FBPOV(FBI)
. . S FBC=FBC+1 ; count of POVs on current line (FBL)
;
; determine if DAYS column should be displayed (true/false)
S FBDD=$$GET1^DIQ(161.8,FBPROG,.01)="STATE HOME"
;
D HD
I '$D(^TMP($J)) W !,"No active authorizations found during period."
S FBC("TOT")=0 ; initialize count of authorizations on report
; loop thru purpose of visit
S FBPOV=0 F S FBPOV=$O(^TMP($J,FBPOV)) Q:'FBPOV D Q:FBQUIT
. S FBPOV("E")=$$GET1^DIQ(161.82,FBPOV,.01)
. I $Y+9>IOSL D HD Q:FBQUIT
. W !!,"POV: ",FBPOV("E")
. S FBC("POV")=0 ; initialize count of authorizations for POV
. S:FBDD FBD("POV")=0 ; initialize count of days for POV
. ; loop thru vendors
. S FBVN="" F S FBVN=$O(^TMP($J,FBPOV,FBVN)) Q:FBVN="" D Q:FBQUIT
. . I $Y+7>IOSL D HD Q:FBQUIT D HDPOV
. . W !!," Vendor: ",FBVN,!
. . S FBC("VEN")=0 ; initialize count of auth for vendor (in POV)
. . S:FBDD FBD("VEN")=0 ; initialize count of days for vendor (in POV)
. . ; loop thru veterans
. . S FBPAT=""
. . F S FBPAT=$O(^TMP($J,FBPOV,FBVN,FBPAT)) Q:FBPAT="" D Q:FBQUIT
. . . S FBPNAME=$P(FBPAT,U)
. . . S FBDFN=$P(FBPAT,U,2)
. . . S DFN=FBDFN D DEM^VADPT ; obtain patient demographics
. . . ; loop thru authorizations
. . . S FBAUT=""
. . . F S FBAUT=$O(^TMP($J,FBPOV,FBVN,FBPAT,FBAUT)) Q:FBAUT="" D Q:FBQUIT
. . . . S FBDTF=$P(FBAUT,U)
. . . . S FBAU=$P(FBAUT,U,2)
. . . . S FBA=^TMP($J,FBPOV,FBVN,FBPAT,FBAUT)
. . . . S:FBDD FBDAYS=$$DOC^FBSHUTL($P(FBA,U),$P(FBA,U,2),FBDT1,FBDT2)
. . . . S FBC("VEN")=FBC("VEN")+1
. . . . S:FBDD FBD("VEN")=FBD("VEN")+FBDAYS
. . . . I $Y+5>IOSL D HD Q:FBQUIT D HDPOV,HDVEN
. . . . W !,?4,FBPNAME,?35,$P(VADM(2),U,2)
. . . . W:FBDD ?48,$J(FBDAYS,3)
. . . . W ?53,$$FMTE^XLFDT($P(FBA,U)),?67,$$FMTE^XLFDT($P(FBA,U,2))
. . . . W !,?6,"DOB: ",$P(VADM(3),U,2)
. . . . I +VADM(6) W ?25,"*** Patient Died on ",$P(VADM(6),U,2)
. . . . ; print remarks (optional)
. . . . I $G(FBAR),$O(^FBAAA(FBDFN,1,FBAU,2,0)) D
. . . . . N DIWL,DIWR,DIWF,FBRR
. . . . . K ^UTILITY($J,"W") S DIWL=7,DIWR=(IOM-5),DIWF="W"
. . . . . S X="REMARKS: ",FBRR=0
. . . . . F S FBRR=$O(^FBAAA(FBDFN,1,FBAU,2,FBRR)) Q:'FBRR S X=X_^(FBRR,0) D ^DIWP S X="" I $Y+6>IOSL D HD Q:FBQUIT D HDPOV,HDVEN,HDPAT
. . . . . D:'FBQUIT ^DIWW
. . . D KVA^VADPT ; clean up patient demographics
. . Q:FBQUIT
. . S FBC("POV")=FBC("POV")+FBC("VEN")
. . S:FBDD FBD("POV")=FBD("POV")+FBD("VEN")
. . I $Y+5>IOSL D HD Q:FBQUIT D HDPOV,HDVEN
. . W !,?32,"----"
. . W:FBDD ?47,"----"
. . W !," Vendor Subtotal:",?25,"Count: ",$J(FBC("VEN"),4)
. . W:FBDD ?41,"Days: ",$J(FBD("VEN"),4)
. Q:FBQUIT
. S FBC("TOT")=FBC("TOT")+FBC("POV")
. I $Y+5>IOSL D HD Q:FBQUIT D HDPOV
. W !,?32,"===="
. W:FBDD ?47,"===="
. W !,"POV Subtotal: ",?25,"Count: ",$J(FBC("POV"),4)
. W:FBDD ?41,"Days: ",$J(FBD("POV"),4)
. ;W !,FBC," Authorization",$S(FBC=1:"",1:"s")," for POV: ",FBPOV("E")
. ;W:FBDD !,"TOTAL DAY(S) FOR POV WITHIN REPORT PERIOD:",?47,$J(FBTDAYS,3)
;
I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
E W !!,FBC("TOT")," Authorization",$S(FBC("TOT")=1:"",1:"s")," on report"
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,FBAR,FBAU,FBAUT,FBC,FBDAYS,FBDD,FBDFN,FBDL,FBDT1,FBDT2,FBDTF
K FBDTR,FBHDT,FBI,FBL,FBPAT,FBPG,FBPNAME,FBPOV,FBPROG,FBSSN,FBQUIT,FBX
K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q
HD ; page header
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 !,"ACTIVE AUTHORIZATIONS by POV, Vendor, Patient"
W ?49,FBDTR,?72,"page ",FBPG
S FBI=0 F S FBI=$O(FBHDT(FBI)) Q:'FBI W !,FBHDT(FBI)
W !!,?4,"VETERAN",?35,"Pt. ID"
W:FBDD ?47,"DAYS"
W ?56,"AUTHORIZATION"
W !,?53,"FROM DATE",?67,"TO DATE"
W !,FBDL
Q
HDPOV ; page header for continued POV
W !,"POV:",FBPOV("E")," (continued)"
Q
HDVEN ; page header for continued Vendor
W !," Vendor: ",FBVN," (continued)"
Q
HDPAT ; page header for continued Patient
W !," Patient: ",FBPNAME," (continued)"
Q
;
;FBSHRAD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBSHRAD 7401 printed Oct 16, 2024@18:00:47 Page 2
FBSHRAD ;WCIOFO/SAB-REPORT ACTIVE AUTHORIZATIONS FOR DATE ;2/9/1999
+1 ;;3.5;FEE BASIS;**13**;JAN 30, 1995
+2 ;
+3 ; ask program
+4 SET DIC="^FBAA(161.8,"
SET DIC(0)="AQEM"
SET DIC("B")="STATE HOME"
+5 DO ^DIC
KILL DIC
IF Y'>0
GOTO EXIT
+6 SET FBPROG=+Y
+7 ;
+8 ; ask purpose of visit(s)
+9 SET DIR(0)="Y"
SET DIR("A")="For ALL Purpose of Visits? Y/N"
SET DIR("B")="YES"
+10 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+11 SET FBPOV=Y
+12 IF 'FBPOV
Begin DoDot:1
+13 KILL FBPOV
+14 WRITE !,"Select one or more Purpose of Visits"
+15 SET DIC="^FBAA(161.82,"
SET DIC(0)="AQEM"
SET DIC("S")="I $P(^(0),U,2)=FBPROG"
+16 FOR
Begin DoDot:2
+17 DO ^DIC
IF Y>0
SET FBPOV(+Y)=$PIECE(Y,U,2)
End DoDot:2
if Y'>0
QUIT
+18 KILL DIC
End DoDot:1
if '$DATA(FBPOV)
GOTO EXIT
SET FBPOV=0
+19 ;
+20 ; ask dates
+21 SET DIR(0)="D^::EX"
SET DIR("A")="From Date"
+22 ; default from date is first day of previous month
+23 SET DIR("B")=$$FMTE^XLFDT($EXTRACT($$FMADD^XLFDT($EXTRACT(DT,1,5)_"01",-1),1,5)_"01")
+24 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+25 SET FBDT1=Y
+26 SET DIR(0)="DA^"_FBDT1_"::EX"
SET DIR("A")="To Date: "
+27 ; default to date is last day of specified month
+28 SET X=FBDT1
DO DAYS^FBAAUTL1
+29 SET DIR("B")=$$FMTE^XLFDT($EXTRACT(FBDT1,1,5)_X)
+30 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+31 SET FBDT2=Y
+32 ;
+33 ; ask if remarks should be printed
+34 SET DIR(0)="Y"
SET DIR("A")="Print authorization remarks"
SET DIR("B")="NO"
+35 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+36 SET FBAR=Y
+37 ;
+38 ; ask device
+39 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+40 IF $DATA(IO("Q"))
Begin DoDot:1
+41 SET ZTRTN="QEN^FBSHRAD"
SET ZTDESC="Active Authorizations Report"
+42 FOR FBX="FBPROG","FBPOV*","FBDT*","FBAR"
SET ZTSAVE(FBX)=""
+43 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+44 ;
QEN ; queued entry
+1 USE IO
+2 ;
GATHER ; collect and sort data
+1 KILL ^TMP($JOB)
+2 ; loop thru Fee Basis Patients
+3 SET FBDFN=0
FOR
SET FBDFN=$ORDER(^FBAAA(FBDFN))
if 'FBDFN
QUIT
Begin DoDot:1
+4 SET FBPNAME=$$GET1^DIQ(161,FBDFN,.01)
+5 if FBPNAME=""
SET FBPNAME="UNKNOWN"
+6 ; loop thru authorizations
+7 SET FBAU=0
FOR
SET FBAU=$ORDER(^FBAAA(FBDFN,1,FBAU))
if 'FBAU
QUIT
Begin DoDot:2
+8 SET FBA=$GET(^FBAAA(FBDFN,1,FBAU,0))
+9 ; not program
if $PIECE(FBA,U,3)'=FBPROG
QUIT
+10 ; austin deleted
if $PIECE($GET(^FBAAA(FBDFN,1,FBAU,"ADEL")),U)
QUIT
+11 ; blank purpose of visit
if $PIECE(FBA,U,7)=""
QUIT
+12 ; not selected POV
IF 'FBPOV
if '$DATA(FBPOV($PIECE(FBA,U,7)))
QUIT
+13 ; ensure authorization is not outside the period of interest
+14 ; auth from date after specified rpt end
if $PIECE(FBA,U)>FBDT2
QUIT
+15 ; auth to date before specified rpt begin
if $PIECE(FBA,U,2)<FBDT1
QUIT
+16 ; passed all criteria
+17 SET FBVN=$SELECT($PIECE(FBA,U,4):$PIECE($GET(^FBAAV($PIECE(FBA,U,4),0)),U),1:"")
+18 IF FBVN=""
SET FBVN="not specified"
+19 ; sort by purpose of visit,vendor,name^dfn,auth from date^auth ien
+20 SET ^TMP($JOB,$PIECE(FBA,U,7),FBVN,FBPNAME_U_FBDFN,$PIECE(FBA,U)_U_FBAU)=FBA
End DoDot:2
End DoDot:1
+21 ;
PRINT ; report data
+1 SET (FBQUIT,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)=" FROM "_$$FMTE^XLFDT(FBDT1)_" TO "_$$FMTE^XLFDT(FBDT2)
+7 SET FBHDT(1)=FBHDT(1)_" FOR THE "_$$GET1^DIQ(161.8,FBPROG,.01)_" PROGRAM"
+8 SET FBHDT(2)=" FOR "_$SELECT(FBPOV:"ALL ",1:"")_"PURPOSE OF VISIT(S)"
+9 IF 'FBPOV
Begin DoDot:1
+10 SET FBL=2
SET FBHDT(FBL)=FBHDT(FBL)_": "
+11 SET (FBC,FBI)=0
FOR
SET FBI=$ORDER(FBPOV(FBI))
if 'FBI
QUIT
Begin DoDot:2
+12 IF $LENGTH(FBHDT(FBL))+2+$LENGTH(FBPOV(FBI))>75
Begin DoDot:3
+13 IF FBC
SET FBHDT(FBL)=FBHDT(FBL)_","
+14 SET FBL=FBL+1
+15 SET FBC=0
SET FBHDT(FBL)=" "
End DoDot:3
+16 SET FBHDT(FBL)=FBHDT(FBL)_$SELECT(FBC:", ",1:"")_FBPOV(FBI)
+17 ; count of POVs on current line (FBL)
SET FBC=FBC+1
End DoDot:2
End DoDot:1
+18 ;
+19 ; determine if DAYS column should be displayed (true/false)
+20 SET FBDD=$$GET1^DIQ(161.8,FBPROG,.01)="STATE HOME"
+21 ;
+22 DO HD
+23 IF '$DATA(^TMP($JOB))
WRITE !,"No active authorizations found during period."
+24 ; initialize count of authorizations on report
SET FBC("TOT")=0
+25 ; loop thru purpose of visit
+26 SET FBPOV=0
FOR
SET FBPOV=$ORDER(^TMP($JOB,FBPOV))
if 'FBPOV
QUIT
Begin DoDot:1
+27 SET FBPOV("E")=$$GET1^DIQ(161.82,FBPOV,.01)
+28 IF $Y+9>IOSL
DO HD
if FBQUIT
QUIT
+29 WRITE !!,"POV: ",FBPOV("E")
+30 ; initialize count of authorizations for POV
SET FBC("POV")=0
+31 ; initialize count of days for POV
if FBDD
SET FBD("POV")=0
+32 ; loop thru vendors
+33 SET FBVN=""
FOR
SET FBVN=$ORDER(^TMP($JOB,FBPOV,FBVN))
if FBVN=""
QUIT
Begin DoDot:2
+34 IF $Y+7>IOSL
DO HD
if FBQUIT
QUIT
DO HDPOV
+35 WRITE !!," Vendor: ",FBVN,!
+36 ; initialize count of auth for vendor (in POV)
SET FBC("VEN")=0
+37 ; initialize count of days for vendor (in POV)
if FBDD
SET FBD("VEN")=0
+38 ; loop thru veterans
+39 SET FBPAT=""
+40 FOR
SET FBPAT=$ORDER(^TMP($JOB,FBPOV,FBVN,FBPAT))
if FBPAT=""
QUIT
Begin DoDot:3
+41 SET FBPNAME=$PIECE(FBPAT,U)
+42 SET FBDFN=$PIECE(FBPAT,U,2)
+43 ; obtain patient demographics
SET DFN=FBDFN
DO DEM^VADPT
+44 ; loop thru authorizations
+45 SET FBAUT=""
+46 FOR
SET FBAUT=$ORDER(^TMP($JOB,FBPOV,FBVN,FBPAT,FBAUT))
if FBAUT=""
QUIT
Begin DoDot:4
+47 SET FBDTF=$PIECE(FBAUT,U)
+48 SET FBAU=$PIECE(FBAUT,U,2)
+49 SET FBA=^TMP($JOB,FBPOV,FBVN,FBPAT,FBAUT)
+50 if FBDD
SET FBDAYS=$$DOC^FBSHUTL($PIECE(FBA,U),$PIECE(FBA,U,2),FBDT1,FBDT2)
+51 SET FBC("VEN")=FBC("VEN")+1
+52 if FBDD
SET FBD("VEN")=FBD("VEN")+FBDAYS
+53 IF $Y+5>IOSL
DO HD
if FBQUIT
QUIT
DO HDPOV
DO HDVEN
+54 WRITE !,?4,FBPNAME,?35,$PIECE(VADM(2),U,2)
+55 if FBDD
WRITE ?48,$JUSTIFY(FBDAYS,3)
+56 WRITE ?53,$$FMTE^XLFDT($PIECE(FBA,U)),?67,$$FMTE^XLFDT($PIECE(FBA,U,2))
+57 WRITE !,?6,"DOB: ",$PIECE(VADM(3),U,2)
+58 IF +VADM(6)
WRITE ?25,"*** Patient Died on ",$PIECE(VADM(6),U,2)
+59 ; print remarks (optional)
+60 IF $GET(FBAR)
IF $ORDER(^FBAAA(FBDFN,1,FBAU,2,0))
Begin DoDot:5
+61 NEW DIWL,DIWR,DIWF,FBRR
+62 KILL ^UTILITY($JOB,"W")
SET DIWL=7
SET DIWR=(IOM-5)
SET DIWF="W"
+63 SET X="REMARKS: "
SET FBRR=0
+64 FOR
SET FBRR=$ORDER(^FBAAA(FBDFN,1,FBAU,2,FBRR))
if 'FBRR
QUIT
SET X=X_^(FBRR,0)
DO ^DIWP
SET X=""
IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
DO HDPOV
DO HDVEN
DO HDPAT
+65 if 'FBQUIT
DO ^DIWW
End DoDot:5
End DoDot:4
if FBQUIT
QUIT
+66 ; clean up patient demographics
DO KVA^VADPT
End DoDot:3
if FBQUIT
QUIT
+67 if FBQUIT
QUIT
+68 SET FBC("POV")=FBC("POV")+FBC("VEN")
+69 if FBDD
SET FBD("POV")=FBD("POV")+FBD("VEN")
+70 IF $Y+5>IOSL
DO HD
if FBQUIT
QUIT
DO HDPOV
DO HDVEN
+71 WRITE !,?32,"----"
+72 if FBDD
WRITE ?47,"----"
+73 WRITE !," Vendor Subtotal:",?25,"Count: ",$JUSTIFY(FBC("VEN"),4)
+74 if FBDD
WRITE ?41,"Days: ",$JUSTIFY(FBD("VEN"),4)
End DoDot:2
if FBQUIT
QUIT
+75 if FBQUIT
QUIT
+76 SET FBC("TOT")=FBC("TOT")+FBC("POV")
+77 IF $Y+5>IOSL
DO HD
if FBQUIT
QUIT
DO HDPOV
+78 WRITE !,?32,"===="
+79 if FBDD
WRITE ?47,"===="
+80 WRITE !,"POV Subtotal: ",?25,"Count: ",$JUSTIFY(FBC("POV"),4)
+81 if FBDD
WRITE ?41,"Days: ",$JUSTIFY(FBD("POV"),4)
+82 ;W !,FBC," Authorization",$S(FBC=1:"",1:"s")," for POV: ",FBPOV("E")
+83 ;W:FBDD !,"TOTAL DAY(S) FOR POV WITHIN REPORT PERIOD:",?47,$J(FBTDAYS,3)
End DoDot:1
if FBQUIT
QUIT
+84 ;
+85 IF FBQUIT
WRITE !!,"REPORT STOPPED AT USER REQUEST"
+86 IF '$TEST
WRITE !!,FBC("TOT")," Authorization",$SELECT(FBC("TOT")=1:"",1:"s")," on report"
+87 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+88 DO ^%ZISC
+89 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB)
+3 KILL FBA,FBAR,FBAU,FBAUT,FBC,FBDAYS,FBDD,FBDFN,FBDL,FBDT1,FBDT2,FBDTF
+4 KILL FBDTR,FBHDT,FBI,FBL,FBPAT,FBPG,FBPNAME,FBPOV,FBPROG,FBSSN,FBQUIT,FBX
+5 KILL DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 QUIT
HD ; page header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF FBPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!FBPG
WRITE @IOF
+4 SET FBPG=FBPG+1
+5 WRITE !,"ACTIVE AUTHORIZATIONS by POV, Vendor, Patient"
+6 WRITE ?49,FBDTR,?72,"page ",FBPG
+7 SET FBI=0
FOR
SET FBI=$ORDER(FBHDT(FBI))
if 'FBI
QUIT
WRITE !,FBHDT(FBI)
+8 WRITE !!,?4,"VETERAN",?35,"Pt. ID"
+9 if FBDD
WRITE ?47,"DAYS"
+10 WRITE ?56,"AUTHORIZATION"
+11 WRITE !,?53,"FROM DATE",?67,"TO DATE"
+12 WRITE !,FBDL
+13 QUIT
HDPOV ; page header for continued POV
+1 WRITE !,"POV:",FBPOV("E")," (continued)"
+2 QUIT
HDVEN ; page header for continued Vendor
+1 WRITE !," Vendor: ",FBVN," (continued)"
+2 QUIT
HDPAT ; page header for continued Patient
+1 WRITE !," Patient: ",FBPNAME," (continued)"
+2 QUIT
+3 ;
+4 ;FBSHRAD
