Routine: PSOADDR

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="@"

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

MESS ;

 W !!,"Nothing queued to print.",!

NAME ;Set name(ssn)

 K VA S DFN=PSONX D PID^VADPT6

 S PSONSSN=$G(PSONI)_"   ("_$E(VA("PID"),5,12)_")"

 K VA

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

CON ;

 I PSOAFLAG,'PSOFORM W !,"  Patient (cont.): ",$G(PSONSSN) S PSOAFLAG=0

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)

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

PSOADDR.m