- 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 Jan 18, 2025@03:01:10 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