PSOADDR ;BIR/RTR-Print address changes from Audit file ;10/17/01
;;7.0;OUTPATIENT PHARMACY;**127,233,326**;DEC 1997;Build 11
;External reference to ^DIA supported by DBIA 2602
;
EN ;
N PSOFORM,PSOAPAT,PSOSDT,PSOEDT,PSOSDTX,PSOEDTX,X,Y,X1,X2
W !!,"This option provides a report that displays changes made to permanent and"
W !,"temporary mailing address information in the PATIENT file (#2). Also changes"
W !,"to the MAIL field (#.03) and the MAIL STATUS EXPIRATION DATE field (#.05)"
W !,"in the PHARMACY PATIENT file (#55) will be displayed."
W !,"Changes can only be displayed if the edits were made using VA FileMan, and the"
W !,"Audit function was turned on for the field(s) at the time of the edit.",!!
K DIR S DIR(0)="SB^S:Single;A:All",DIR("A")="Print report for a Single patient, or All patients",DIR("B")="Single",DIR("?")=" ",DIR("?",1)="Enter 'S' to print address changes for one patient over the selected"
S DIR("?",2)="date range, enter 'A' to print address changes for all patients",DIR("?",3)="over the selected date range."
D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) D MESS Q
S PSOFORM=$S(Y="S":1,1:0)
I 'PSOFORM G DATE
K DIC W ! S DIC(0)="QEAM",DIC("A")="Select PATIENT: " D EN^PSOPATLK S Y=PSOPTLK K DIC,PSOPTLK I Y<1!($D(DUOUT))!($D(DTOUT)) D MESS Q
S PSOAPAT=+Y
DATE ;
W !!
I PSOFORM W !,"This report will be sorted by Date/time of edit."
I 'PSOFORM W !,"This report will be sorted by Patient Name, and within Patient Name will be",!,"sorted by Date/time of edit."
W !,"A beginning and ending date must now be entered for the search."
K DIR W ! S DIR(0)="DAO^:DT:APEX",DIR("A")="Beginning Date: ",DIR("?")=" ",DIR("?",1)="Enter the date to begin searching for changes to address fields.",DIR("?",2)="A future date cannot be entered." D ^DIR K DIR
I 'Y!($D(DTOUT))!($D(DUOUT)) D MESS Q
S PSOSDT=Y D DD^%DT S PSOSDTX=Y
S X1=PSOSDT,X2=-1 D C^%DTC S PSOSDT=X_".9999"
W ! K DIR S DIR(0)="DAO^"_PSOSDT_"::APEX",DIR("A")="Ending Date: ",DIR("?")=" ",DIR("?",1)="Enter the ending date of the search for changes to address fields.",DIR("?",2)="This date cannot be before the beginning date." D ^DIR K DIR
I 'Y!($D(DTOUT))!($D(DUOUT)) D MESS Q
S PSOEDT=Y D DD^%DT S PSOEDTX=Y
S X1=PSOEDT,X2=+1 D C^%DTC S PSOEDT=X
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) D MESS Q
I $D(IO("Q")) D Q
.S ZTRTN="REP^PSOADDR",ZTDESC="Pharmacy Address change report",ZTSAVE("PSOFORM")="",ZTSAVE("PSOAPAT")="",ZTSAVE("PSOSDT")="",ZTSAVE("PSOEDT")="",ZTSAVE("PSOEDTX")="",ZTSAVE("PSOSDTX")="" D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",!
REP ;
K ^TMP("PSOADD",$J)
N PSODEV,PSOUT,PSOLINE,PSOPAGE,PSOADND,PSOADUSR,PSOADF,PSOADFF,PSOAOPT,PSOAOPTA,PSOAOPTZ,PSOAOPTB,PSOAOPTC,PSOADLP,PSOANODE,PSOADX,PSOADXX,PSOADATE,PSOC,PSOAALL,PSOADFN,PSOANAME,PSONI,PSONX,PSONB,PSOASN,VA,DFN,PSONSSN,PSOAFLAG
U IO
S (PSOUT,PSOAFLAG)=0,PSODEV=$S($E(IOST,1,2)'="C-":0,1:1),PSOPAGE=1
S $P(PSOLINE,"-",78)=""
I $G(PSOFORM) G ONE
ALL ;Print report for all patients
N PSOFILE
F PSOFILE=2,55 F PSOAALL=PSOSDT:0 S PSOAALL=$O(^DIA(PSOFILE,"C",PSOAALL)) Q:'PSOAALL!(PSOEDT'>PSOAALL) S PSOADLP="" F S PSOADLP=$O(^DIA(PSOFILE,"C",PSOAALL,PSOADLP)) Q:PSOADLP="" D
.S PSOADFN=$P($G(^DIA(PSOFILE,PSOADLP,0)),"^"),PSOC=$P($G(^(0)),"^",3) Q:'PSOADFN
.S PSOANAME=$P($G(^DPT(PSOADFN,0)),"^") Q:PSOANAME=""
.I PSOFILE=2 I PSOC=.111!(PSOC=.112)!(PSOC=.113)!(PSOC=.114)!(PSOC=.115)!(PSOC=.116)!(PSOC=.1211)!(PSOC=.1212)!(PSOC=.1213)!(PSOC=.1214)!(PSOC=.1215)!(PSOC=.1216)!(PSOC=.1112)!(PSOC=.12112)!(PSOC=.121)!(PSOC=.1217)!(PSOC=.1218)!(PSOC=.12105) D
..S ^TMP("PSOADD",$J,PSOANAME,PSOADFN,PSOAALL,PSOFILE,PSOADLP)=$G(^DIA(2,PSOADLP,0))
.I PSOFILE=55 I PSOC=.03!(PSOC=.05) D
..S ^TMP("PSOADD",$J,PSOANAME,PSOADFN,PSOAALL,PSOFILE,PSOADLP)=$G(^DIA(55,PSOADLP,0))
D HD
I '$D(^TMP("PSOADD",$J)) W !!,"No data found to print for this date range.",! G END
S PSONI="" F S PSONI=$O(^TMP("PSOADD",$J,PSONI)) Q:PSONI=""!(PSOUT) S PSONX="" F S PSONX=$O(^TMP("PSOADD",$J,PSONI,PSONX)) Q:PSONX=""!(PSOUT) D NAME S PSONB="" F S PSONB=$O(^TMP("PSOADD",$J,PSONI,PSONX,PSONB)) Q:PSONB=""!(PSOUT) D
.F PSOFILE=2,55 S PSOADXX="" F S PSOADXX=$O(^TMP("PSOADD",$J,PSONI,PSONX,PSONB,PSOFILE,PSOADXX)) Q:PSOADXX=""!(PSOUT) D
..I ($Y+5)>IOSL D HD Q:PSOUT
..S Y=PSONB D DD^%DT S PSOADATE=Y
..S PSOADND=$G(^TMP("PSOADD",$J,PSONI,PSONX,PSONB,PSOFILE,PSOADXX))
..D FLD
..D PRALL
G END
ONE ;Print report for one patient
N PSOFILE
F PSOFILE=2,55 S PSOADLP="" F S PSOADLP=$O(^DIA(PSOFILE,"B",PSOAPAT,PSOADLP)) Q:PSOADLP="" S PSOC=$P($G(^DIA(PSOFILE,PSOADLP,0)),"^",3) D
.S PSOANODE=$G(^DIA(PSOFILE,PSOADLP,0))
.I +$P($G(PSOANODE),"^",2)>PSOSDT,+$P($G(PSOANODE),"^",2)<PSOEDT D
..I PSOFILE=2 I PSOC=.111!(PSOC=.112)!(PSOC=.113)!(PSOC=.114)!(PSOC=.115)!(PSOC=.116)!(PSOC=.1211)!(PSOC=.1212)!(PSOC=.1213)!(PSOC=.1214)!(PSOC=.1215)!(PSOC=.1216)!(PSOC=.1112)!(PSOC=.12112)!(PSOC=.121)!(PSOC=.1217)!(PSOC=.1218)!(PSOC=.12105) D
...S ^TMP("PSOADD",$J,+$P(PSOANODE,"^",2),PSOFILE,PSOADLP)=PSOANODE
..I PSOFILE=55 I PSOC=.03!(PSOC=.05) D
...S ^TMP("PSOADD",$J,+$P(PSOANODE,"^",2),PSOFILE,PSOADLP)=PSOANODE
K VA S DFN=PSOAPAT D PID^VADPT6 S PSOASN=$P($G(^DPT(+$G(PSOAPAT),0)),"^")_" ("_$E(VA("PID"),5,12)_")"
K VA
D HD
I '$D(^TMP("PSOADD",$J)) W !!,"No data found to print for this date range.",! G END
S PSOADX="" F S PSOADX=$O(^TMP("PSOADD",$J,PSOADX)) Q:PSOADX=""!(PSOUT) F PSOFILE=2,55 S PSOADXX="" F S PSOADXX=$O(^TMP("PSOADD",$J,PSOADX,PSOFILE,PSOADXX)) Q:PSOADXX=""!(PSOUT) D
.I ($Y+5)>IOSL D HD Q:PSOUT
.S Y=PSOADX D DD^%DT S PSOADATE=Y
.S PSOADND=$G(^TMP("PSOADD",$J,PSOADX,PSOFILE,PSOADXX))
.D FLD
.W ! D PRONE
END ;
K ^TMP("PSOADD",$J)
I '$G(PSOUT),PSODEV W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I 'PSODEV W !!,"End of Report."
I PSODEV W !
E W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
HD ;
I '$G(PSOFORM) S PSOAFLAG=1
I PSODEV,PSOPAGE'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSOUT=1 Q
I PSOPAGE=1,'PSODEV W ! I 1
E W @IOF
D W ?67,"PAGE: "_PSOPAGE S PSOPAGE=PSOPAGE+1
.I PSOFORM W !,"Address changes for "_$G(PSOASN) Q
.W !,"Address changes for ALL Patients"
W !,"made between "_$G(PSOSDTX)_" and "_$G(PSOEDTX)
W !,PSOLINE
Q
MESS ;
W !!,"Nothing queued to print.",!
Q
NAME ;Set name(ssn)
K VA S DFN=PSONX D PID^VADPT6
S PSONSSN=$G(PSONI)_" ("_$E(VA("PID"),5,12)_")"
K VA
Q
PRALL ;Print data for all patients
S PSOAFLAG=0
W !!," Patient: ",$G(PSONSSN) I ($Y+5)>IOSL D HD Q:PSOUT
PRONE ;Print data for one patient
D CON W !,"Date/time of edit: ",$G(PSOADATE) I ($Y+5)>IOSL D HD Q:PSOUT
D CON W !," Field edited: ",$G(PSOADFF) I ($Y+5)>IOSL D HD Q:PSOUT
D CON W !," Edited by: ",$G(PSOADUSR) I ($Y+5)>IOSL D HD Q:PSOUT
D CON W !," Option/Protocol: ",$G(PSOAOPT) I ($Y+5)>IOSL D HD Q:PSOUT
D CON W !," Old Value: ",$S($P($G(^DIA(PSOFILE,PSOADXX,2)),"^")'="":$P($G(^(2)),"^"),1:"<no previous value>") I ($Y+5)>IOSL D HD Q:PSOUT
D CON W !," New Value: ",$S($P($G(^DIA(PSOFILE,PSOADXX,3)),"^")'="":$P($G(^(3)),"^"),1:"<no current value>") I ($Y+5)>IOSL D HD
Q
CON ;
I PSOAFLAG,'PSOFORM W !," Patient (cont.): ",$G(PSONSSN) S PSOAFLAG=0
Q
FLD ;Set field value
K PSOADF D FIELD^DID(PSOFILE,$P(PSOADND,"^",3),"","LABEL","PSOADF")
S PSOADFF=$G(PSOADF("LABEL"))
USR ;Set user value
S PSOADUSR=$P(PSOADND,"^",4) I 'PSOADUSR S PSOADUSR="UNKNOWN"
I PSOADUSR'="UNKNOWN" K DIC S DIC="^VA(200,",DIC(0)="MZO",X="`"_PSOADUSR D ^DIC S PSOADUSR=$P($G(Y),"^",2) K DIC
I $G(PSOADUSR)="" S PSOADUSR="UNKNOWN"
PROT ;Set value of protocol or option
S (PSOAOPT,PSOAOPTB,PSOAOPTC)=""
I $G(^DIA(PSOFILE,PSOADXX,4.1))="" S PSOAOPT="/" Q
S PSOAOPTA=$P($G(^DIA(PSOFILE,PSOADXX,4.1)),"^")
I PSOAOPTA K DIQ,DIC,PSOAOPTZ S DIC=19,DR=".01",DA=PSOAOPTA,DIQ(0)="E",DIQ="PSOAOPTZ" D EN^DIQ1 S PSOAOPTB=$G(PSOAOPTZ(19,PSOAOPTA,.01,"E")) K DIQ,DA,DR,PSOAOPTZ
S PSOAOPTA=$P($G(^DIA(PSOFILE,PSOADXX,4.1)),"^",2)
K PSOAOPTZ I $P(PSOAOPTA,";",2)="ORD(101," K DIC S DIC=101,DR=".01",DA=+PSOAOPTA,DIQ(0)="E",DIQ="PSOAOPTZ" D EN^DIQ1 S PSOAOPTC=$G(PSOAOPTZ(101,+PSOAOPTA,.01,"E")) K DA,DR,DIC,DIQ,PSOAOPTZ
I $P(PSOAOPTA,";",2)'="ORD(101,",+PSOAOPTA K DIC,DIQ S DIC=19,DR=".01",DA=+PSOAOPTA,DIQ(0)="E",DIQ="PSOAOPTZ" D EN^DIQ1 S PSOAOPTC=$G(PSOAOPTZ(19,+PSOAOPTA,.01,"E")) K PSOAOPTZ,DIC,DA,DR,DIQ
S PSOAOPT=$G(PSOAOPTB)_"/"_$G(PSOAOPTC)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOADDR 8545 printed Sep 23, 2025@20:00:17 Page 2
PSOADDR ;BIR/RTR-Print address changes from Audit file ;10/17/01
+1 ;;7.0;OUTPATIENT PHARMACY;**127,233,326**;DEC 1997;Build 11
+2 ;External reference to ^DIA supported by DBIA 2602
+3 ;
EN ;
+1 NEW PSOFORM,PSOAPAT,PSOSDT,PSOEDT,PSOSDTX,PSOEDTX,X,Y,X1,X2
+2 WRITE !!,"This option provides a report that displays changes made to permanent and"
+3 WRITE !,"temporary mailing address information in the PATIENT file (#2). Also changes"
+4 WRITE !,"to the MAIL field (#.03) and the MAIL STATUS EXPIRATION DATE field (#.05)"
+5 WRITE !,"in the PHARMACY PATIENT file (#55) will be displayed."
+6 WRITE !,"Changes can only be displayed if the edits were made using VA FileMan, and the"
+7 WRITE !,"Audit function was turned on for the field(s) at the time of the edit.",!!
+8 KILL DIR
SET DIR(0)="SB^S:Single;A:All"
SET DIR("A")="Print report for a Single patient, or All patients"
SET DIR("B")="Single"
SET DIR("?")=" "
SET DIR("?",1)="Enter 'S' to print address changes for one patient over the selected"
+9 SET DIR("?",2)="date range, enter 'A' to print address changes for all patients"
SET DIR("?",3)="over the selected date range."
+10 DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
DO MESS
QUIT
+11 SET PSOFORM=$SELECT(Y="S":1,1:0)
+12 IF 'PSOFORM
GOTO DATE
+13 KILL DIC
WRITE !
SET DIC(0)="QEAM"
SET DIC("A")="Select PATIENT: "
DO EN^PSOPATLK
SET Y=PSOPTLK
KILL DIC,PSOPTLK
IF Y<1!($DATA(DUOUT))!($DATA(DTOUT))
DO MESS
QUIT
+14 SET PSOAPAT=+Y
DATE ;
+1 WRITE !!
+2 IF PSOFORM
WRITE !,"This report will be sorted by Date/time of edit."
+3 IF 'PSOFORM
WRITE !,"This report will be sorted by Patient Name, and within Patient Name will be",!,"sorted by Date/time of edit."
+4 WRITE !,"A beginning and ending date must now be entered for the search."
+5 KILL DIR
WRITE !
SET DIR(0)="DAO^:DT:APEX"
SET DIR("A")="Beginning Date: "
SET DIR("?")=" "
SET DIR("?",1)="Enter the date to begin searching for changes to address fields."
SET DIR("?",2)="A future date cannot be entered."
DO ^DIR
KILL DIR
+6 IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
DO MESS
QUIT
+7 SET PSOSDT=Y
DO DD^%DT
SET PSOSDTX=Y
+8 SET X1=PSOSDT
SET X2=-1
DO C^%DTC
SET PSOSDT=X_".9999"
+9 WRITE !
KILL DIR
SET DIR(0)="DAO^"_PSOSDT_"::APEX"
SET DIR("A")="Ending Date: "
SET DIR("?")=" "
SET DIR("?",1)="Enter the ending date of the search for changes to address fields."
SET DIR("?",2)="This date cannot be before the beginning date."
DO ^DIR
KILL DIR
+10 IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
DO MESS
QUIT
+11 SET PSOEDT=Y
DO DD^%DT
SET PSOEDTX=Y
+12 SET X1=PSOEDT
SET X2=+1
DO C^%DTC
SET PSOEDT=X
+13 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
DO MESS
QUIT
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTRTN="REP^PSOADDR"
SET ZTDESC="Pharmacy Address change report"
SET ZTSAVE("PSOFORM")=""
SET ZTSAVE("PSOAPAT")=""
SET ZTSAVE("PSOSDT")=""
SET ZTSAVE("PSOEDT")=""
SET ZTSAVE("PSOEDTX")=""
SET ZTSAVE("PSOSDTX")=""
DO ^%ZTLOAD
KILL %ZIS
WRITE !!,"Report queued to print.",!
End DoDot:1
QUIT
REP ;
+1 KILL ^TMP("PSOADD",$JOB)
+2 NEW PSODEV,PSOUT,PSOLINE,PSOPAGE,PSOADND,PSOADUSR,PSOADF,PSOADFF,PSOAOPT,PSOAOPTA,PSOAOPTZ,PSOAOPTB,PSOAOPTC,PSOADLP,PSOANODE,PSOADX,PSOADXX,PSOADATE,PSOC,PSOAALL,PSOADFN,PSOANAME,PSONI,PSONX,PSONB,PSOASN,VA,DFN,PSONSSN,PSOAFLAG
+3 USE IO
+4 SET (PSOUT,PSOAFLAG)=0
SET PSODEV=$SELECT($EXTRACT(IOST,1,2)'="C-":0,1:1)
SET PSOPAGE=1
+5 SET $PIECE(PSOLINE,"-",78)=""
+6 IF $GET(PSOFORM)
GOTO ONE
ALL ;Print report for all patients
+1 NEW PSOFILE
+2 FOR PSOFILE=2,55
FOR PSOAALL=PSOSDT:0
SET PSOAALL=$ORDER(^DIA(PSOFILE,"C",PSOAALL))
if 'PSOAALL!(PSOEDT'>PSOAALL)
QUIT
SET PSOADLP=""
FOR
SET PSOADLP=$ORDER(^DIA(PSOFILE,"C",PSOAALL,PSOADLP))
if PSOADLP=""
QUIT
Begin DoDot:1
+3 SET PSOADFN=$PIECE($GET(^DIA(PSOFILE,PSOADLP,0)),"^")
SET PSOC=$PIECE($GET(^(0)),"^",3)
if 'PSOADFN
QUIT
+4 SET PSOANAME=$PIECE($GET(^DPT(PSOADFN,0)),"^")
if PSOANAME=""
QUIT
+5 IF PSOFILE=2
IF PSOC=.111!(PSOC=.112)!(PSOC=.113)!(PSOC=.114)!(PSOC=.115)!(PSOC=.116)!(PSOC=.1211)!(PSOC=.1212)!(PSOC=.1213)!(PSOC=.1214)!(PSOC=.1215)!(PSOC=.1216)!(PSOC=.1112)!(PSOC=.12112)!(PSOC=.121)!(PSOC=.1217)!(PSOC=.1218)!(PSOC=.1
2105)
Begin DoDot:2
+6 SET ^TMP("PSOADD",$JOB,PSOANAME,PSOADFN,PSOAALL,PSOFILE,PSOADLP)=$GET(^DIA(2,PSOADLP,0))
End DoDot:2
+7 IF PSOFILE=55
IF PSOC=.03!(PSOC=.05)
Begin DoDot:2
+8 SET ^TMP("PSOADD",$JOB,PSOANAME,PSOADFN,PSOAALL,PSOFILE,PSOADLP)=$GET(^DIA(55,PSOADLP,0))
End DoDot:2
End DoDot:1
+9 DO HD
+10 IF '$DATA(^TMP("PSOADD",$JOB))
WRITE !!,"No data found to print for this date range.",!
GOTO END
+11 SET PSONI=""
FOR
SET PSONI=$ORDER(^TMP("PSOADD",$JOB,PSONI))
if PSONI=""!(PSOUT)
QUIT
SET PSONX=""
FOR
SET PSONX=$ORDER(^TMP("PSOADD",$JOB,PSONI,PSONX))
if PSONX=""!(PSOUT)
QUIT
DO NAME
SET PSONB=""
FOR
SET PSONB=$ORDER(^TMP("PSOADD",$JOB,PSONI,PSONX,PSONB))
if PSONB=""!(PSOUT)
QUIT
Begin DoDot:1
+12 FOR PSOFILE=2,55
SET PSOADXX=""
FOR
SET PSOADXX=$ORDER(^TMP("PSOADD",$JOB,PSONI,PSONX,PSONB,PSOFILE,PSOADXX))
if PSOADXX=""!(PSOUT)
QUIT
Begin DoDot:2
+13 IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+14 SET Y=PSONB
DO DD^%DT
SET PSOADATE=Y
+15 SET PSOADND=$GET(^TMP("PSOADD",$JOB,PSONI,PSONX,PSONB,PSOFILE,PSOADXX))
+16 DO FLD
+17 DO PRALL
End DoDot:2
End DoDot:1
+18 GOTO END
ONE ;Print report for one patient
+1 NEW PSOFILE
+2 FOR PSOFILE=2,55
SET PSOADLP=""
FOR
SET PSOADLP=$ORDER(^DIA(PSOFILE,"B",PSOAPAT,PSOADLP))
if PSOADLP=""
QUIT
SET PSOC=$PIECE($GET(^DIA(PSOFILE,PSOADLP,0)),"^",3)
Begin DoDot:1
+3 SET PSOANODE=$GET(^DIA(PSOFILE,PSOADLP,0))
+4 IF +$PIECE($GET(PSOANODE),"^",2)>PSOSDT
IF +$PIECE($GET(PSOANODE),"^",2)<PSOEDT
Begin DoDot:2
+5 IF PSOFILE=2
IF PSOC=.111!(PSOC=.112)!(PSOC=.113)!(PSOC=.114)!(PSOC=.115)!(PSOC=.116)!(PSOC=.1211)!(PSOC=.1212)!(PSOC=.1213)!(PSOC=.1214)!(PSOC=.1215)!(PSOC=.1216)!(PSOC=.1112)!(PSOC=.12112)!(PSOC=.121)!(PSOC=.1217)!(PSOC=.1218)!
(PSOC=.12105)
Begin DoDot:3
+6 SET ^TMP("PSOADD",$JOB,+$PIECE(PSOANODE,"^",2),PSOFILE,PSOADLP)=PSOANODE
End DoDot:3
+7 IF PSOFILE=55
IF PSOC=.03!(PSOC=.05)
Begin DoDot:3
+8 SET ^TMP("PSOADD",$JOB,+$PIECE(PSOANODE,"^",2),PSOFILE,PSOADLP)=PSOANODE
End DoDot:3
End DoDot:2
End DoDot:1
+9 KILL VA
SET DFN=PSOAPAT
DO PID^VADPT6
SET PSOASN=$PIECE($GET(^DPT(+$GET(PSOAPAT),0)),"^")_" ("_$EXTRACT(VA("PID"),5,12)_")"
+10 KILL VA
+11 DO HD
+12 IF '$DATA(^TMP("PSOADD",$JOB))
WRITE !!,"No data found to print for this date range.",!
GOTO END
+13 SET PSOADX=""
FOR
SET PSOADX=$ORDER(^TMP("PSOADD",$JOB,PSOADX))
if PSOADX=""!(PSOUT)
QUIT
FOR PSOFILE=2,55
SET PSOADXX=""
FOR
SET PSOADXX=$ORDER(^TMP("PSOADD",$JOB,PSOADX,PSOFILE,PSOADXX))
if PSOADXX=""!(PSOUT)
QUIT
Begin DoDot:1
+14 IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+15 SET Y=PSOADX
DO DD^%DT
SET PSOADATE=Y
+16 SET PSOADND=$GET(^TMP("PSOADD",$JOB,PSOADX,PSOFILE,PSOADXX))
+17 DO FLD
+18 WRITE !
DO PRONE
End DoDot:1
END ;
+1 KILL ^TMP("PSOADD",$JOB)
+2 IF '$GET(PSOUT)
IF PSODEV
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+3 IF 'PSODEV
WRITE !!,"End of Report."
+4 IF PSODEV
WRITE !
+5 IF '$TEST
WRITE @IOF
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
HD ;
+1 IF '$GET(PSOFORM)
SET PSOAFLAG=1
+2 IF PSODEV
IF PSOPAGE'=1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSOUT=1
QUIT
+3 IF PSOPAGE=1
IF 'PSODEV
WRITE !
IF 1
+4 IF '$TEST
WRITE @IOF
+5 Begin DoDot:1
+6 IF PSOFORM
WRITE !,"Address changes for "_$GET(PSOASN)
QUIT
+7 WRITE !,"Address changes for ALL Patients"
End DoDot:1
WRITE ?67,"PAGE: "_PSOPAGE
SET PSOPAGE=PSOPAGE+1
+8 WRITE !,"made between "_$GET(PSOSDTX)_" and "_$GET(PSOEDTX)
+9 WRITE !,PSOLINE
+10 QUIT
MESS ;
+1 WRITE !!,"Nothing queued to print.",!
+2 QUIT
NAME ;Set name(ssn)
+1 KILL VA
SET DFN=PSONX
DO PID^VADPT6
+2 SET PSONSSN=$GET(PSONI)_" ("_$EXTRACT(VA("PID"),5,12)_")"
+3 KILL VA
+4 QUIT
PRALL ;Print data for all patients
+1 SET PSOAFLAG=0
+2 WRITE !!," Patient: ",$GET(PSONSSN)
IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
PRONE ;Print data for one patient
+1 DO CON
WRITE !,"Date/time of edit: ",$GET(PSOADATE)
IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+2 DO CON
WRITE !," Field edited: ",$GET(PSOADFF)
IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+3 DO CON
WRITE !," Edited by: ",$GET(PSOADUSR)
IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+4 DO CON
WRITE !," Option/Protocol: ",$GET(PSOAOPT)
IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+5 DO CON
WRITE !," Old Value: ",$SELECT($PIECE($GET(^DIA(PSOFILE,PSOADXX,2)),"^")'="":$PIECE($GET(^(2)),"^"),1:"<no previous value>")
IF ($Y+5)>IOSL
DO HD
if PSOUT
QUIT
+6 DO CON
WRITE !," New Value: ",$SELECT($PIECE($GET(^DIA(PSOFILE,PSOADXX,3)),"^")'="":$PIECE($GET(^(3)),"^"),1:"<no current value>")
IF ($Y+5)>IOSL
DO HD
+7 QUIT
CON ;
+1 IF PSOAFLAG
IF 'PSOFORM
WRITE !," Patient (cont.): ",$GET(PSONSSN)
SET PSOAFLAG=0
+2 QUIT
FLD ;Set field value
+1 KILL PSOADF
DO FIELD^DID(PSOFILE,$PIECE(PSOADND,"^",3),"","LABEL","PSOADF")
+2 SET PSOADFF=$GET(PSOADF("LABEL"))
USR ;Set user value
+1 SET PSOADUSR=$PIECE(PSOADND,"^",4)
IF 'PSOADUSR
SET PSOADUSR="UNKNOWN"
+2 IF PSOADUSR'="UNKNOWN"
KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="MZO"
SET X="`"_PSOADUSR
DO ^DIC
SET PSOADUSR=$PIECE($GET(Y),"^",2)
KILL DIC
+3 IF $GET(PSOADUSR)=""
SET PSOADUSR="UNKNOWN"
PROT ;Set value of protocol or option
+1 SET (PSOAOPT,PSOAOPTB,PSOAOPTC)=""
+2 IF $GET(^DIA(PSOFILE,PSOADXX,4.1))=""
SET PSOAOPT="/"
QUIT
+3 SET PSOAOPTA=$PIECE($GET(^DIA(PSOFILE,PSOADXX,4.1)),"^")
+4 IF PSOAOPTA
KILL DIQ,DIC,PSOAOPTZ
SET DIC=19
SET DR=".01"
SET DA=PSOAOPTA
SET DIQ(0)="E"
SET DIQ="PSOAOPTZ"
DO EN^DIQ1
SET PSOAOPTB=$GET(PSOAOPTZ(19,PSOAOPTA,.01,"E"))
KILL DIQ,DA,DR,PSOAOPTZ
+5 SET PSOAOPTA=$PIECE($GET(^DIA(PSOFILE,PSOADXX,4.1)),"^",2)
+6 KILL PSOAOPTZ
IF $PIECE(PSOAOPTA,";",2)="ORD(101,"
KILL DIC
SET DIC=101
SET DR=".01"
SET DA=+PSOAOPTA
SET DIQ(0)="E"
SET DIQ="PSOAOPTZ"
DO EN^DIQ1
SET PSOAOPTC=$GET(PSOAOPTZ(101,+PSOAOPTA,.01,"E"))
KILL DA,DR,DIC,DIQ,PSOAOPTZ
+7 IF $PIECE(PSOAOPTA,";",2)'="ORD(101,"
IF +PSOAOPTA
KILL DIC,DIQ
SET DIC=19
SET DR=".01"
SET DA=+PSOAOPTA
SET DIQ(0)="E"
SET DIQ="PSOAOPTZ"
DO EN^DIQ1
SET PSOAOPTC=$GET(PSOAOPTZ(19,+PSOAOPTA,.01,"E"))
KILL PSOAOPTZ,DIC,DA,DR,DIQ
+8 SET PSOAOPT=$GET(PSOAOPTB)_"/"_$GET(PSOAOPTC)
+9 QUIT
