PSOTPCRP ;BIR/RTR-Non VA phycisian eligible patient report ;07/07/03
;;7.0;OUTPATIENT PHARMACY;**145,153,227**;DEC 1997
Q ;placed out of order by patch PSO*7*227
EN ;
W !!,"This report prints entries from the TPB ELIGIBILITY file (#52.91)."
W !,"If multiple Institutions are selected, and some Institutions have data and",!,"some don't, only those Institutions that have data will print on the report.",!
N PSOGPINS,PSOGPAR,PSOGOK,PSOGSORT
S PSOGPINS=0
INST ;Ask for Institutions
K DIR S DIR(0)="S^S:SELECT;A:ALL",DIR("B")="SELECT",DIR("A")="Print Report for Selected Institutions, or All Institutions" D D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! Q
.S DIR("?")=" ",DIR("?",1)="Enter 'S' to select one or more Institutions to print the report for,",DIR("?",2)="Enter 'A' to print the report for all Institutions."
I Y="A" S PSOGPINS=1 G PASS
S PSOGOK=0
INSTX ;Ask for individual Institutions
K DIC S DIC(0)="QEAMZ",DIC=4 D W ! D ^DIC K DIC I 'PSOGOK,(Y<1!($D(DUOUT))!($D(DTOUT))) W !!,"Nothing queued to print.",! Q
.I 'PSOGOK,$G(DUZ(2)) S DIC("B")=DUZ(2)
.I PSOGOK S DIC("A")="Select another INSTITUTION NAME:"
I Y>0 S PSOGPAR(+Y)="",PSOGOK=1 G INSTX
I '$O(PSOGPAR(0)) W !,"No Institutions selected, nothing queued to print.",! Q
PASS ;
ACT ;Ask for type of report
W ! K DIR S DIR(0)="S^A:ALL PATIENTS;E:ELIGIBLE PATIENTS;I:INELIGIBLE PATIENTS",DIR("B")="ALL PATIENTS",DIR("A")="Select patients for report" D D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! Q
.S DIR("?")=" ",DIR("?",1)="To see only those patients currently eligible for the Transitional Pharmacy",DIR("?",2)="Benefit program, enter 'E'. To see all patients currently in the TPB"
.S DIR("?",3)="ELIGIBILITY file (#52.91), but not currently eligible for the benefit,",DIR("?",4)="enter 'I'. To see all patients in the TPB ELIGIBILITY file (#52.91),"
.S DIR("?",5)="both eligible and ineligible, enter 'A'."
S PSOGSORT=Y
W ! K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! Q
I $D(IO("Q")) S ZTRTN="START^PSOTPCRP",ZTDESC="TPB ELIGIBILITY Report",ZTSAVE("PSOGPINS")="",ZTSAVE("PSOGSORT")="",ZTSAVE("PSOGPAR(")="" D ^%ZTLOAD K %ZIS W !,"Report queued to print.",! K ZTRTN,ZTDESC,ZTSAVE Q
START ;
K ^TMP("PSOGP",$J)
U IO
N DIC,DIQ,DA,DR,PSOGPOUT,PSOGDV,PSOGPAGE,PSOGTOP,PSOGPLIN,PSOGLOP,PSOGNODE,PSOGNAME,PSOINAME,PSOTAR,PSOG1,PSOG2,PSOG3,PSOG4,DFN,VADM,PSOGSSN,PSOGSSNX,PSOXND,PSOXRS,VA,VAERR,PSOTINS,PSOTARX,PSOVADIS,PSOVADIX
I '$G(DT) S DT=$$DT^XLFDT
S PSOGPOUT=0,PSOGDV=$S($E(IOST,1,2)'="C-":0,1:1),PSOGPAGE=1
S $P(PSOGPLIN,"-",79)=""
;Set TMP global, store grand total count in PSOGTOP, Subtotals in PSOTAR array
S PSOGTOP=0
F PSOGLOP=0:0 S PSOGLOP=$O(^PS(52.91,PSOGLOP)) Q:'PSOGLOP D
.S PSOGNODE=$G(^PS(52.91,PSOGLOP,0)) I 'PSOGNODE Q
.;If selecting institutions, and patient if file with no Institution won't show on the report??
.I 'PSOGPINS,'$D(PSOGPAR(+$P(PSOGNODE,"^",8))),$P(PSOGNODE,"^",8) Q
.I PSOGSORT="E",$P(PSOGNODE,"^",3),$P(PSOGNODE,"^",3)'>DT Q
.I PSOGSORT="I" I '$P(PSOGNODE,"^",3)!($P(PSOGNODE,"^",3)>DT) Q
.K VADM S DFN=+$P(PSOGNODE,"^") I 'DFN Q
.D DEM^VADPT I $G(VADM(1))="" K VADM Q
.S PSOGNAME=$G(VADM(1))
.K VADM
.K VA,VAERR S DFN=+$P(PSOGNODE,"^") D PID^VADPT6
.S PSOGNAME=PSOGNAME_"("_$G(VA("BID"))_")"
.K VA,VAERR
.S ^TMP("PSOGP",$J,$S($P(PSOGNODE,"^",8):$P(PSOGNODE,"^",8),1:"NONE"),PSOGNAME,$P(PSOGNODE,"^"),PSOGLOP)="",PSOGTOP=PSOGTOP+1
.I $P(PSOGNODE,"^",8) S PSOTAR($P(PSOGNODE,"^",8))=$G(PSOTAR($P(PSOGNODE,"^",8)))+1 Q
.S PSOTAR("NONE")=$G(PSOTAR("NONE"))+1
;D HD
I 'PSOGTOP D HD W !!,"No patients found that meet report criteria.",! G END
S PSOG1="" F S PSOG1=$O(^TMP("PSOGP",$J,PSOG1)) Q:PSOG1=""!(PSOGPOUT) D
.I $G(PSOG1)="NONE" S PSOINAME="NONE"
.I $G(PSOG1)'="NONE" K PSOTINS,DIC,DIQ,DA,DR S DIC=4,DR=".01",DA=+PSOG1,DIQ(0)="E",DIQ="PSOTINS" D EN^DIQ1 S PSOINAME=$G(PSOTINS(4,+PSOG1,.01,"E")) K DIC,DIQ,DR,DA,PSOTINS
.D HD I PSOGPOUT Q
.S PSOTARX=0
.S PSOG2="" F S PSOG2=$O(^TMP("PSOGP",$J,PSOG1,PSOG2)) Q:PSOG2=""!(PSOGPOUT) F PSOG3=0:0 S PSOG3=$O(^TMP("PSOGP",$J,PSOG1,PSOG2,PSOG3)) Q:'PSOG3!(PSOGPOUT) D
..F PSOG4=0:0 S PSOG4=$O(^TMP("PSOGP",$J,PSOG1,PSOG2,PSOG3,PSOG4)) Q:'PSOG4!(PSOGPOUT) D
...S PSOXND=$G(^PS(52.91,PSOG4,0))
...D ADDR
...S PSOTARX=PSOTARX+1
...W !!,PSOG2
...W ?38,$S($P(PSOXND,"^",2):$E($P(PSOXND,"^",2),4,5)_"/"_$E($P(PSOXND,"^",2),6,7)_"/"_$E($P(PSOXND,"^",2),2,3),1:"")
...W ?47,$S($P(PSOXND,"^",3):$E($P(PSOXND,"^",3),4,5)_"/"_$E($P(PSOXND,"^",3),6,7)_"/"_$E($P(PSOXND,"^",3),2,3),1:"")
...W ?56,$S($P(PSOXND,"^",12):$E($P(PSOXND,"^",12),4,5)_"/"_$E($P(PSOXND,"^",12),6,7)_"/"_$E($P(PSOXND,"^",12),2,3),1:"")
...S PSOXRS=$P(PSOXND,"^",4)
...W ?65,$S(PSOXRS=1:"VA Provider",PSOXRS=2:"No/Show/Cancel",PSOXRS=3:"Patient Ended",PSOXRS=4:"N/F Rx",PSOXRS=5:"Patient Expired",PSOXRS=6:"Rx's Inactive",PSOXRS=7:"Exclusion",PSOXRS=8:"Refused Appt.",PSOXRS=9:"Pat Unreachable",1:"")
...I $P(PSOXND,"^",9) D
....I $P(PSOXND,"^",9)=1 W !?1,"Exclusion: ACTIVE RX "_$P(PSOXND,"^",11) Q
....I $P(PSOXND,"^",9)=2 W !?1,"Exclusion: ACTUAL APPT. <30 DAYS FROM DATE APPT. MADE" Q
....I $P(PSOXND,"^",9)=3 W !?1,"Exclusion: ACTIVE RX "_$P(PSOXND,"^",11)_" & ACTUAL APPT. <30 DAYS FROM DATE APPT. MADE"
...I ($Y+6)>IOSL,$G(PSOVADIS)'="" D HD I PSOGPOUT K PSOVADIS,PSOVADIX Q
...I $G(PSOVADIS)'="" W !,$G(PSOVADIS)
...I ($Y+6)>IOSL,$G(PSOVADIX)'="" D HD I PSOGPOUT K PSOVADIS,PSOVADIX Q
...I $G(PSOVADIX)'="" W !,$G(PSOVADIX)
...K PSOVADIS,PSOVADIX
...I ($Y+6)>IOSL,PSOTARX'=$G(PSOTAR(PSOG1)) D HD
G END
HD ;HEADER
I PSOGDV,PSOGPAGE'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSOGPOUT=1 Q
I PSOGPAGE=1,'PSOGDV W ! I 1
E W @IOF
W !,$S(PSOGSORT="E":"Eligible Patients",PSOGSORT="I":"Ineligible Patients",1:"All Patients")_$S($G(PSOINAME)="":"",1:" (")_$G(PSOINAME)_$S($G(PSOINAME)="":"",1:")")_" Total: "_$S($G(PSOG1)'="":$G(PSOTAR(PSOG1)),1:""),?68,"PAGE: "_PSOGPAGE
S PSOGPAGE=PSOGPAGE+1
;I $G(PSOINAME)'="" W !,"("_PSOINAME_")"_" Total: ",$G(PSOTAR(PSOG1))
W !,"Grand Total: "_PSOGTOP,?38,"Start",?47,"Stop",?56,"Letter",?65,"Inactivation",!,"Patient",?38,"Date",?47,"Date",?56,"Date",?65,"Reason",!,PSOGPLIN
Q
END ;End report
K ^TMP("PSOGP",$J),PSOGPAR,PSOGSORT,PSOGPINS
I '$G(PSOGPOUT),PSOGDV W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I 'PSOGDV W !!,"End of Report."
I PSOGDV W !
E W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
ADDR ;Check for difference in State
N PSOVA1,PSOVA2,VAPA
S (PSOVADIX,PSOVADIS)=""
S DFN=$P($G(^PS(52.91,PSOG4,0)),"^")
I '$G(DFN) Q
D ADD^VADPT
I '$G(VAPA(12)) K VAPA G ADDRX
I $P($G(VAPA(22,1)),"^",3)'="Y",$P($G(VAPA(22,2)),"^",3)'="Y",$P($G(VAPA(22,5)),"^",3)'="Y" K VAPA G ADDRX
S PSOVADIS="Confidential State = "_$P($G(VAPA(17)),"^",2)
I $G(VAPA(5))'=$G(VAPA(17)) S PSOVADIX=$S($G(VAPA(9)):"Temporary State = ",1:"Permanent State = ")_$P($G(VAPA(5)),"^",2)
K VAPA
Q
ADDRX ;
K VAPA D ADD^VADPT I '$G(VAPA(9)) S PSOVADIS="Permanent State = "_$P($G(VAPA(5)),"^",2) K VAPA Q
S PSOVADIS="Temporary State = "_$P($G(VAPA(5)),"^",2)
S PSOVA1=$G(VAPA(5))
K VAPA S VAPA("P")="" D ADD^VADPT
S PSOVA2=$G(VAPA(5))
I PSOVA1=PSOVA2 K VAPA Q
S PSOVADIX="Permanent State = "_$P($G(PSOVA2),"^",2)
K VAPA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTPCRP 7474 printed Apr 09, 2024@21:31:32 Page 2
PSOTPCRP ;BIR/RTR-Non VA phycisian eligible patient report ;07/07/03
+1 ;;7.0;OUTPATIENT PHARMACY;**145,153,227**;DEC 1997
+2 ;placed out of order by patch PSO*7*227
QUIT
EN ;
+1 WRITE !!,"This report prints entries from the TPB ELIGIBILITY file (#52.91)."
+2 WRITE !,"If multiple Institutions are selected, and some Institutions have data and",!,"some don't, only those Institutions that have data will print on the report.",!
+3 NEW PSOGPINS,PSOGPAR,PSOGOK,PSOGSORT
+4 SET PSOGPINS=0
INST ;Ask for Institutions
+1 KILL DIR
SET DIR(0)="S^S:SELECT;A:ALL"
SET DIR("B")="SELECT"
SET DIR("A")="Print Report for Selected Institutions, or All Institutions"
Begin DoDot:1
+2 SET DIR("?")=" "
SET DIR("?",1)="Enter 'S' to select one or more Institutions to print the report for,"
SET DIR("?",2)="Enter 'A' to print the report for all Institutions."
End DoDot:1
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!,"Nothing queued to print.",!
QUIT
+3 IF Y="A"
SET PSOGPINS=1
GOTO PASS
+4 SET PSOGOK=0
INSTX ;Ask for individual Institutions
+1 KILL DIC
SET DIC(0)="QEAMZ"
SET DIC=4
Begin DoDot:1
+2 IF 'PSOGOK
IF $GET(DUZ(2))
SET DIC("B")=DUZ(2)
+3 IF PSOGOK
SET DIC("A")="Select another INSTITUTION NAME:"
End DoDot:1
WRITE !
DO ^DIC
KILL DIC
IF 'PSOGOK
IF (Y<1!($DATA(DUOUT))!($DATA(DTOUT)))
WRITE !!,"Nothing queued to print.",!
QUIT
+4 IF Y>0
SET PSOGPAR(+Y)=""
SET PSOGOK=1
GOTO INSTX
+5 IF '$ORDER(PSOGPAR(0))
WRITE !,"No Institutions selected, nothing queued to print.",!
QUIT
PASS ;
ACT ;Ask for type of report
+1 WRITE !
KILL DIR
SET DIR(0)="S^A:ALL PATIENTS;E:ELIGIBLE PATIENTS;I:INELIGIBLE PATIENTS"
SET DIR("B")="ALL PATIENTS"
SET DIR("A")="Select patients for report"
Begin DoDot:1
+2 SET DIR("?")=" "
SET DIR("?",1)="To see only those patients currently eligible for the Transitional Pharmacy"
SET DIR("?",2)="Benefit program, enter 'E'. To see all patients currently in the TPB"
+3 SET DIR("?",3)="ELIGIBILITY file (#52.91), but not currently eligible for the benefit,"
SET DIR("?",4)="enter 'I'. To see all patients in the TPB ELIGIBILITY file (#52.91),"
+4 SET DIR("?",5)="both eligible and ineligible, enter 'A'."
End DoDot:1
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!,"Nothing queued to print.",!
QUIT
+5 SET PSOGSORT=Y
+6 WRITE !
KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
WRITE !!,"Nothing queued to print.",!
QUIT
+7 IF $DATA(IO("Q"))
SET ZTRTN="START^PSOTPCRP"
SET ZTDESC="TPB ELIGIBILITY Report"
SET ZTSAVE("PSOGPINS")=""
SET ZTSAVE("PSOGSORT")=""
SET ZTSAVE("PSOGPAR(")=""
DO ^%ZTLOAD
KILL %ZIS
WRITE !,"Report queued to print.",!
KILL ZTRTN,ZTDESC,ZTSAVE
QUIT
START ;
+1 KILL ^TMP("PSOGP",$JOB)
+2 USE IO
+3 NEW DIC,DIQ,DA,DR,PSOGPOUT,PSOGDV,PSOGPAGE,PSOGTOP,PSOGPLIN,PSOGLOP,PSOGNODE,PSOGNAME,PSOINAME,PSOTAR,PSOG1,PSOG2,PSOG3,PSOG4,DFN,VADM,PSOGSSN,PSOGSSNX,PSOXND,PSOXRS,VA,VAERR,PSOTINS,PSOTARX,PSOVADIS,PSOVADIX
+4 IF '$GET(DT)
SET DT=$$DT^XLFDT
+5 SET PSOGPOUT=0
SET PSOGDV=$SELECT($EXTRACT(IOST,1,2)'="C-":0,1:1)
SET PSOGPAGE=1
+6 SET $PIECE(PSOGPLIN,"-",79)=""
+7 ;Set TMP global, store grand total count in PSOGTOP, Subtotals in PSOTAR array
+8 SET PSOGTOP=0
+9 FOR PSOGLOP=0:0
SET PSOGLOP=$ORDER(^PS(52.91,PSOGLOP))
if 'PSOGLOP
QUIT
Begin DoDot:1
+10 SET PSOGNODE=$GET(^PS(52.91,PSOGLOP,0))
IF 'PSOGNODE
QUIT
+11 ;If selecting institutions, and patient if file with no Institution won't show on the report??
+12 IF 'PSOGPINS
IF '$DATA(PSOGPAR(+$PIECE(PSOGNODE,"^",8)))
IF $PIECE(PSOGNODE,"^",8)
QUIT
+13 IF PSOGSORT="E"
IF $PIECE(PSOGNODE,"^",3)
IF $PIECE(PSOGNODE,"^",3)'>DT
QUIT
+14 IF PSOGSORT="I"
IF '$PIECE(PSOGNODE,"^",3)!($PIECE(PSOGNODE,"^",3)>DT)
QUIT
+15 KILL VADM
SET DFN=+$PIECE(PSOGNODE,"^")
IF 'DFN
QUIT
+16 DO DEM^VADPT
IF $GET(VADM(1))=""
KILL VADM
QUIT
+17 SET PSOGNAME=$GET(VADM(1))
+18 KILL VADM
+19 KILL VA,VAERR
SET DFN=+$PIECE(PSOGNODE,"^")
DO PID^VADPT6
+20 SET PSOGNAME=PSOGNAME_"("_$GET(VA("BID"))_")"
+21 KILL VA,VAERR
+22 SET ^TMP("PSOGP",$JOB,$SELECT($PIECE(PSOGNODE,"^",8):$PIECE(PSOGNODE,"^",8),1:"NONE"),PSOGNAME,$PIECE(PSOGNODE,"^"),PSOGLOP)=""
SET PSOGTOP=PSOGTOP+1
+23 IF $PIECE(PSOGNODE,"^",8)
SET PSOTAR($PIECE(PSOGNODE,"^",8))=$GET(PSOTAR($PIECE(PSOGNODE,"^",8)))+1
QUIT
+24 SET PSOTAR("NONE")=$GET(PSOTAR("NONE"))+1
End DoDot:1
+25 ;D HD
+26 IF 'PSOGTOP
DO HD
WRITE !!,"No patients found that meet report criteria.",!
GOTO END
+27 SET PSOG1=""
FOR
SET PSOG1=$ORDER(^TMP("PSOGP",$JOB,PSOG1))
if PSOG1=""!(PSOGPOUT)
QUIT
Begin DoDot:1
+28 IF $GET(PSOG1)="NONE"
SET PSOINAME="NONE"
+29 IF $GET(PSOG1)'="NONE"
KILL PSOTINS,DIC,DIQ,DA,DR
SET DIC=4
SET DR=".01"
SET DA=+PSOG1
SET DIQ(0)="E"
SET DIQ="PSOTINS"
DO EN^DIQ1
SET PSOINAME=$GET(PSOTINS(4,+PSOG1,.01,"E"))
KILL DIC,DIQ,DR,DA,PSOTINS
+30 DO HD
IF PSOGPOUT
QUIT
+31 SET PSOTARX=0
+32 SET PSOG2=""
FOR
SET PSOG2=$ORDER(^TMP("PSOGP",$JOB,PSOG1,PSOG2))
if PSOG2=""!(PSOGPOUT)
QUIT
FOR PSOG3=0:0
SET PSOG3=$ORDER(^TMP("PSOGP",$JOB,PSOG1,PSOG2,PSOG3))
if 'PSOG3!(PSOGPOUT)
QUIT
Begin DoDot:2
+33 FOR PSOG4=0:0
SET PSOG4=$ORDER(^TMP("PSOGP",$JOB,PSOG1,PSOG2,PSOG3,PSOG4))
if 'PSOG4!(PSOGPOUT)
QUIT
Begin DoDot:3
+34 SET PSOXND=$GET(^PS(52.91,PSOG4,0))
+35 DO ADDR
+36 SET PSOTARX=PSOTARX+1
+37 WRITE !!,PSOG2
+38 WRITE ?38,$SELECT($PIECE(PSOXND,"^",2):$EXTRACT($PIECE(PSOXND,"^",2),4,5)_"/"_$EXTRACT($PIECE(PSOXND,"^",2),6,7)_"/"_$EXTRACT($PIECE(PSOXND,"^",2),2,3),1:"")
+39 WRITE ?47,$SELECT($PIECE(PSOXND,"^",3):$EXTRACT($PIECE(PSOXND,"^",3),4,5)_"/"_$EXTRACT($PIECE(PSOXND,"^",3),6,7)_"/"_$EXTRACT($PIECE(PSOXND,"^",3),2,3),1:"")
+40 WRITE ?56,$SELECT($PIECE(PSOXND,"^",12):$EXTRACT($PIECE(PSOXND,"^",12),4,5)_"/"_$EXTRACT($PIECE(PSOXND,"^",12),6,7)_"/"_$EXTRACT($PIECE(PSOXND,"^",12),2,3),1:"")
+41 SET PSOXRS=$PIECE(PSOXND,"^",4)
+42 WRITE ?65,$SELECT(PSOXRS=1:"VA Provider",PSOXRS=2:"No/Show/Cancel",PSOXRS=3:"Patient Ended",PSOXRS=4:"N/F Rx",PSOXRS=5:"Patient Expired",PSOXRS=6:"Rx's Inactive",PSOXRS=7:"Exclusion",PSOXRS=8:"Refused Appt.",PSOXRS=9
:"Pat Unreachable",1:"")
+43 IF $PIECE(PSOXND,"^",9)
Begin DoDot:4
+44 IF $PIECE(PSOXND,"^",9)=1
WRITE !?1,"Exclusion: ACTIVE RX "_$PIECE(PSOXND,"^",11)
QUIT
+45 IF $PIECE(PSOXND,"^",9)=2
WRITE !?1,"Exclusion: ACTUAL APPT. <30 DAYS FROM DATE APPT. MADE"
QUIT
+46 IF $PIECE(PSOXND,"^",9)=3
WRITE !?1,"Exclusion: ACTIVE RX "_$PIECE(PSOXND,"^",11)_" & ACTUAL APPT. <30 DAYS FROM DATE APPT. MADE"
End DoDot:4
+47 IF ($Y+6)>IOSL
IF $GET(PSOVADIS)'=""
DO HD
IF PSOGPOUT
KILL PSOVADIS,PSOVADIX
QUIT
+48 IF $GET(PSOVADIS)'=""
WRITE !,$GET(PSOVADIS)
+49 IF ($Y+6)>IOSL
IF $GET(PSOVADIX)'=""
DO HD
IF PSOGPOUT
KILL PSOVADIS,PSOVADIX
QUIT
+50 IF $GET(PSOVADIX)'=""
WRITE !,$GET(PSOVADIX)
+51 KILL PSOVADIS,PSOVADIX
+52 IF ($Y+6)>IOSL
IF PSOTARX'=$GET(PSOTAR(PSOG1))
DO HD
End DoDot:3
End DoDot:2
End DoDot:1
+53 GOTO END
HD ;HEADER
+1 IF PSOGDV
IF PSOGPAGE'=1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSOGPOUT=1
QUIT
+2 IF PSOGPAGE=1
IF 'PSOGDV
WRITE !
IF 1
+3 IF '$TEST
WRITE @IOF
+4 WRITE !,$SELECT(PSOGSORT="E":"Eligible Patients",PSOGSORT="I":"Ineligible Patients",1:"All Patients")_$SELECT(...
... $GET(PSOINAME)="":"",1:" (")_$GET(PSOINAME)_$SELECT($GET(PSOINAME)="":"",1:")")_" Total: "_$SELECT($GET(PSOG1)'="":$GET(PSOTAR(PSOG1)),1:""),?68,"PAGE: "_PSOGPAGE
+5 SET PSOGPAGE=PSOGPAGE+1
+6 ;I $G(PSOINAME)'="" W !,"("_PSOINAME_")"_" Total: ",$G(PSOTAR(PSOG1))
+7 WRITE !,"Grand Total: "_PSOGTOP,?38,"Start",?47,"Stop",?56,"Letter",?65,"Inactivation",!,"Patient",?38,"Date",?47,"Date",?56,"Date",?65,"Reason",!,PSOGPLIN
+8 QUIT
END ;End report
+1 KILL ^TMP("PSOGP",$JOB),PSOGPAR,PSOGSORT,PSOGPINS
+2 IF '$GET(PSOGPOUT)
IF PSOGDV
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+3 IF 'PSOGDV
WRITE !!,"End of Report."
+4 IF PSOGDV
WRITE !
+5 IF '$TEST
WRITE @IOF
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
ADDR ;Check for difference in State
+1 NEW PSOVA1,PSOVA2,VAPA
+2 SET (PSOVADIX,PSOVADIS)=""
+3 SET DFN=$PIECE($GET(^PS(52.91,PSOG4,0)),"^")
+4 IF '$GET(DFN)
QUIT
+5 DO ADD^VADPT
+6 IF '$GET(VAPA(12))
KILL VAPA
GOTO ADDRX
+7 IF $PIECE($GET(VAPA(22,1)),"^",3)'="Y"
IF $PIECE($GET(VAPA(22,2)),"^",3)'="Y"
IF $PIECE($GET(VAPA(22,5)),"^",3)'="Y"
KILL VAPA
GOTO ADDRX
+8 SET PSOVADIS="Confidential State = "_$PIECE($GET(VAPA(17)),"^",2)
+9 IF $GET(VAPA(5))'=$GET(VAPA(17))
SET PSOVADIX=$SELECT($GET(VAPA(9)):"Temporary State = ",1:"Permanent State = ")_$PIECE($GET(VAPA(5)),"^",2)
+10 KILL VAPA
+11 QUIT
ADDRX ;
+1 KILL VAPA
DO ADD^VADPT
IF '$GET(VAPA(9))
SET PSOVADIS="Permanent State = "_$PIECE($GET(VAPA(5)),"^",2)
KILL VAPA
QUIT
+2 SET PSOVADIS="Temporary State = "_$PIECE($GET(VAPA(5)),"^",2)
+3 SET PSOVA1=$GET(VAPA(5))
+4 KILL VAPA
SET VAPA("P")=""
DO ADD^VADPT
+5 SET PSOVA2=$GET(VAPA(5))
+6 IF PSOVA1=PSOVA2
KILL VAPA
QUIT
+7 SET PSOVADIX="Permanent State = "_$PIECE($GET(PSOVA2),"^",2)
+8 KILL VAPA
+9 QUIT
