PSOBAIRP.m

PSOBAIRP ;BIR/RTR-Report of prescription mail labels with bad address ;08/16/2006

 ;;7.0;OUTPATIENT PHARMACY;**233,326**;DEC 1997;Build 11

 ;

EN ;

 N PSOFORM,PSOAPAT,PSOSDT,PSOEDT,PSOSDTX,PSOEDTX,X,Y,X1,X2

 W !!,"This option provides a report that shows patients and prescriptions whose last"

 W !,"label activity had a routing of mail and no valid permanent or temporary"

 W !,"address. It will also indicate whether the patient now has a good address.",!!

 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 !!

 W ! K %DT S %DT="AEX",%DT("A")="Start fill date: " D ^%DT K %DT I Y<0!($D(DTOUT))!($D(DUOUT)) D MESS Q 

 S (%DT(0),PSOSDT)=Y D DD^%DT S PSOSDTX=Y

 W ! S %DT="AEX",%DT("A")="End fill date: " D ^%DT K %DT I Y<0!($D(DTOUT))!($D(DUOUT)) D MESS Q

 S PSOEDT=Y D DD^%DT S PSOEDTX=Y

 S X1=PSOSDT,X2=-1 D C^%DTC S PSOSDT=X_".9999"

 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^PSOBAIRP",ZTDESC="Pharmacy bad address mail label 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("PSOBADL",$J)

 N PSODEV,PSOUT,PSOLINE,PSOPAGE,PSOADND,PSOADF,PSOADFF,PSOAOPT,PSOAOPTA,PSOAOPTZ,PSOAOPTB,PSOAOPTC,PSOADLP,PSOANODE,PSOADX,PSORX,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)=""

ALL ;Print report for all patients

 N PSORD,PSORX,PSOLBL,PSOX

 S PSORD=PSOSDT F  S PSORD=$O(^PSRX("AD",PSORD)) Q:'PSORD!(PSORD>PSOEDT)  D

 .S PSORX=0 F  S PSORX=$O(^PSRX("AD",PSORD,PSORX)) Q:'PSORX  D

 ..S PSOLBL=$O(^PSRX(PSORX,"L",999999),-1) I 'PSOLBL Q

 ..S PSOX=$G(^PSRX(PSORX,"L",PSOLBL,0)) I PSOX["(BAD ADDRESS",PSOX'["WINDOW" D

 ...S PSOADFN=$P($G(^PSRX(PSORX,0)),"^",2) Q:'PSOADFN

 ...I $G(PSOFORM),PSOADFN'=PSOAPAT Q

 ...S PSOANAME=$P($G(^DPT(PSOADFN,0)),"^") Q:PSOANAME=""

 ...S ^TMP("PSOBADL",$J,PSOANAME,PSOADFN,PSORD,PSORX)=""

 D HD

 I '$D(^TMP("PSOBADL",$J)) W !!,"No data found to print for this date range.",! G END

 S PSONI="" F  S PSONI=$O(^TMP("PSOBADL",$J,PSONI)) Q:PSONI=""!(PSOUT)  D

 .S PSONX="" F  S PSONX=$O(^TMP("PSOBADL",$J,PSONI,PSONX)) Q:PSONX=""!(PSOUT)  D NAME,PRALL D

 ..S PSONB="" F  S PSONB=$O(^TMP("PSOBADL",$J,PSONI,PSONX,PSONB)) Q:PSONB=""!(PSOUT)  D

 ...S PSORX="" F  S PSORX=$O(^TMP("PSOBADL",$J,PSONI,PSONX,PSONB,PSORX)) Q:PSORX=""!(PSOUT)  D

 ....I ($Y+5)>IOSL D HD Q:PSOUT

 ....S Y=PSONB D DD^%DT S PSOADATE=Y

 ....D PRONE

END ;

 K ^TMP("PSOBADL",$J)

 K DTOUT,DUOUT

 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 !,"Bad address mail label report for "_$G(PSOANAME) Q

 .W !,"Bad address mail label report for ALL Patients"

 W !,"for fill date 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

 N PSOADDR

 S PSOADDR=""

 S PSOAFLAG=0

 W !!,$G(PSONSSN) D CHKADDR W ?30,"  ",PSOADDR I ($Y+5)>IOSL D HD Q:PSOUT

 Q

PRONE ;Print data for one patient

 N PSORX0

 S PSORX0=$G(^PSRX(PSORX,0)) I PSORX0=""!($P(PSORX0,"^",6)="") Q

 D CON W !,$G(PSOADATE),?15," Rx#: ",$P(PSORX0,"^"),?30,"  ",$P($G(^PSDRUG($P(PSORX0,"^",6),0)),"^")

 I ($Y+5)>IOSL D HD Q:PSOUT

 Q

CON ;

 I PSOAFLAG,'PSOFORM W !,$G(PSONSSN) S PSOAFLAG=0

 Q

 ;

CHKADDR ;

 N PSOBADR,PSOTEMP

 I $G(PSONX)="" Q

 S PSOBADR=$$BADADR^DGUTL3(PSONX)

 I PSOBADR D

 .S PSOTEMP=$$CHKTEMP^PSOBAI(PSONX)

 I PSOBADR,'PSOTEMP S PSOADDR="** BAD ADDRESS **" Q

 S PSOADDR="PATIENT NOW HAS A VALID ADDRESS"

 Q

PSOBAIRP  ;BIR/RTR-Report of prescription mail labels with bad address ;08/16/2006

 +1       ;;7.0;OUTPATIENT PHARMACY;**233,326**;DEC 1997;Build 11

 +2       ;

EN        ;

 +1        NEW PSOFORM,PSOAPAT,PSOSDT,PSOEDT,PSOSDTX,PSOEDTX,X,Y,X1,X2

 +2        WRITE !!,"This option provides a report that shows patients and prescriptions whose last"

 +3        WRITE !,"label activity had a routing of mail and no valid permanent or temporary"

 +4        WRITE !,"address. It will also indicate whether the patient now has a good address.",!!

 +5        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"

 +6        SET DIR("?",2)="date range, enter 'A' to print address changes for all patients"

           SET DIR("?",3)="over the selected date range."

 +7        DO ^DIR

           KILL DIR

           IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))

               DO MESS

               QUIT 

 +8        SET PSOFORM=$SELECT(Y="S":1,1:0)

 +9        IF 'PSOFORM

               GOTO DATE

 +10       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 

 +11       SET PSOAPAT=+Y

DATE      ;

 +1        WRITE !!

 +2        WRITE !

           KILL %DT

           SET %DT="AEX"

           SET %DT("A")="Start fill date: "

           DO ^%DT

           KILL %DT

           IF Y<0!($DATA(DTOUT))!($DATA(DUOUT))

               DO MESS

               QUIT 

 +3        SET (%DT(0),PSOSDT)=Y

           DO DD^%DT

           SET PSOSDTX=Y

 +4        WRITE !

           SET %DT="AEX"

           SET %DT("A")="End fill date: "

           DO ^%DT

           KILL %DT

           IF Y<0!($DATA(DTOUT))!($DATA(DUOUT))

               DO MESS

               QUIT 

 +5        SET PSOEDT=Y

           DO DD^%DT

           SET PSOEDTX=Y

 +6        SET X1=PSOSDT

           SET X2=-1

           DO C^%DTC

           SET PSOSDT=X_".9999"

 +7        SET X1=PSOEDT

           SET X2=+1

           DO C^%DTC

           SET PSOEDT=X

 +8        KILL IOP,%ZIS,POP

           SET %ZIS="QM"

           DO ^%ZIS

           IF $GET(POP)

               DO MESS

               QUIT 

 +9        IF $DATA(IO("Q"))

               Begin DoDot:1

 +10               SET ZTRTN="REP^PSOBAIRP"

                   SET ZTDESC="Pharmacy bad address mail label report"

                   SET ZTSAVE("PSOFORM")=""

                   SET ZTSAVE("PSOAPAT")=""

                   SET ZTSAVE("PSOSDT")=""

                   SET ZTSAVE("PSOEDT")=""

                   SET ZTSAVE("PSOEDTX")=""

                   SET ZTSAVE("PSOSDTX")=""

                   DO ^%ZTLOAD

                   KILL %ZIS

 +11               WRITE !!,"Report queued to print.",!

               End DoDot:1

               QUIT 

REP       ;

 +1        KILL ^TMP("PSOBADL",$JOB)

 +2        NEW PSODEV,PSOUT,PSOLINE,PSOPAGE,PSOADND,PSOADF,PSOADFF,PSOAOPT,PSOAOPTA,PSOAOPTZ,PSOAOPTB,PSOAOPTC,PSOADLP,PSOANODE,PSOADX,PSORX,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)=""

ALL       ;Print report for all patients

 +1        NEW PSORD,PSORX,PSOLBL,PSOX

 +2        SET PSORD=PSOSDT

           FOR 

               SET PSORD=$ORDER(^PSRX("AD",PSORD))

               IF 'PSORD!(PSORD>PSOEDT)

                   QUIT 

               Begin DoDot:1

 +3                SET PSORX=0

                   FOR 

                       SET PSORX=$ORDER(^PSRX("AD",PSORD,PSORX))

                       IF 'PSORX

                           QUIT 

                       Begin DoDot:2

 +4                        SET PSOLBL=$ORDER(^PSRX(PSORX,"L",999999),-1)

                           IF 'PSOLBL

                               QUIT 

 +5                        SET PSOX=$GET(^PSRX(PSORX,"L",PSOLBL,0))

                           IF PSOX["(BAD ADDRESS"

                               IF PSOX'["WINDOW"

                                   Begin DoDot:3

 +6                                    SET PSOADFN=$PIECE($GET(^PSRX(PSORX,0)),"^",2)

                                       IF 'PSOADFN

                                           QUIT 

 +7                                    IF $GET(PSOFORM)

                                           IF PSOADFN'=PSOAPAT

                                               QUIT 

 +8                                    SET PSOANAME=$PIECE($GET(^DPT(PSOADFN,0)),"^")

                                       IF PSOANAME=""

                                           QUIT 

 +9                                    SET ^TMP("PSOBADL",$JOB,PSOANAME,PSOADFN,PSORD,PSORX)=""

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10       DO HD

 +11       IF '$DATA(^TMP("PSOBADL",$JOB))

               WRITE !!,"No data found to print for this date range.",!

               GOTO END

 +12       SET PSONI=""

           FOR 

               SET PSONI=$ORDER(^TMP("PSOBADL",$JOB,PSONI))

               IF PSONI=""!(PSOUT)

                   QUIT 

               Begin DoDot:1

 +13               SET PSONX=""

                   FOR 

                       SET PSONX=$ORDER(^TMP("PSOBADL",$JOB,PSONI,PSONX))

                       IF PSONX=""!(PSOUT)

                           QUIT 

                       DO NAME

                       DO PRALL

                       Begin DoDot:2

 +14                       SET PSONB=""

                           FOR 

                               SET PSONB=$ORDER(^TMP("PSOBADL",$JOB,PSONI,PSONX,PSONB))

                               IF PSONB=""!(PSOUT)

                                   QUIT 

                               Begin DoDot:3

 +15                               SET PSORX=""

                                   FOR 

                                       SET PSORX=$ORDER(^TMP("PSOBADL",$JOB,PSONI,PSONX,PSONB,PSORX))

                                       IF PSORX=""!(PSOUT)

                                           QUIT 

                                       Begin DoDot:4

 +16                                       IF ($Y+5)>IOSL

                                               DO HD

                                               IF PSOUT

                                                   QUIT 

 +17                                       SET Y=PSONB

                                           DO DD^%DT

                                           SET PSOADATE=Y

 +18                                       DO PRONE

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

END       ;

 +1        KILL ^TMP("PSOBADL",$JOB)

 +2        KILL DTOUT,DUOUT

 +3        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

 +4        IF 'PSODEV

               WRITE !!,"End of Report."

 +5        IF PSODEV

               WRITE !

 +6       IF '$TEST

               WRITE @IOF

 +7        DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +8        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 !,"Bad address mail label report for "_$GET(PSOANAME)

                   QUIT 

 +7            WRITE !,"Bad address mail label report for ALL Patients"

           End DoDot:1

           WRITE ?67,"PAGE: "_PSOPAGE

           SET PSOPAGE=PSOPAGE+1

 +8        WRITE !,"for fill date 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        NEW PSOADDR

 +2        SET PSOADDR=""

 +3        SET PSOAFLAG=0

 +4        WRITE !!,$GET(PSONSSN)

           DO CHKADDR

           WRITE ?30,"  ",PSOADDR

           IF ($Y+5)>IOSL

               DO HD

               IF PSOUT

                   QUIT 

 +5        QUIT 

PRONE     ;Print data for one patient

 +1        NEW PSORX0

 +2        SET PSORX0=$GET(^PSRX(PSORX,0))

           IF PSORX0=""!($PIECE(PSORX0,"^",6)="")

               QUIT 

 +3        DO CON

           WRITE !,$GET(PSOADATE),?15," Rx#: ",$PIECE(PSORX0,"^"),?30,"  ",$PIECE($GET(^PSDRUG($PIECE(PSORX0,"^",6),0)),"^")

 +4        IF ($Y+5)>IOSL

               DO HD

               IF PSOUT

                   QUIT 

 +5        QUIT 

CON       ;

 +1        IF PSOAFLAG

               IF 'PSOFORM

                   WRITE !,$GET(PSONSSN)

                   SET PSOAFLAG=0

 +2        QUIT 

 +3       ;

CHKADDR   ;

 +1        NEW PSOBADR,PSOTEMP

 +2        IF $GET(PSONX)=""

               QUIT 

 +3        SET PSOBADR=$$BADADR^DGUTL3(PSONX)

 +4        IF PSOBADR

               Begin DoDot:1

 +5                SET PSOTEMP=$$CHKTEMP^PSOBAI(PSONX)

               End DoDot:1

 +6        IF PSOBADR

               IF 'PSOTEMP

                   SET PSOADDR="** BAD ADDRESS **"

                   QUIT 

 +7        SET PSOADDR="PATIENT NOW HAS A VALID ADDRESS"

 +8        QUIT