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