APSPDRP.m

APSPDRP ; IHS/DSD/ENM - SORT ENTRIES FROM DUE REVIEW FILE ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;------------------------------------------------------------

START ;

 D BD ; Ask Beginning and Ending Dates

 G:'$D(APSPDRP("ED")) END

 D DIC ;Select the DUE Study

 G:'$D(APSPDRP("DFN'S")) END

 D QUE ;Ask Device

 G:POP!($D(IOQ)) END

EN D BODY ;Main driver for rest of routine

END D EOJ ; Clean up local variables

 Q

 ;--------------------------------------------------------------

BD ;

 K ^TMP("APSPDRP1",$J)

 S %DT("A")="PLEASE ENTER BEGINNING DATE: "

 S %DT="AE"

 D ^%DT

 I Y=-1 G BDX

 S APSPDRP("BD")=Y

 S %DT("A")="PLEASE ENTER ENDING DATE: "

 D ^%DT

 I Y=-1 G:X="" BD G BDX

 S APSPDRP("ED")=Y_".999999"

BDX Q

 ;

DIC ;

 S DIC="^APSPDUE(32.1,"

 S DIC(0)="AEQM"

 D ^DIC K DIC,DR

 I Y>0,'$D(^APSPDUE(32,"D",+Y)) W !,"No Review's on File for this Study..",! S DIC("A")="ANOTHER ONE: " G DIC

 I Y>0 S APSPDRP("DFN'S",+Y)="",DIC("A")="ANOTHER ONE: " G DIC

 K:$D(DTOUT)!($D(DUOUT)) APSPDRP("DFN'S")

 Q

QUE ;

 W !

 S %ZIS="QMN"

 D ^%ZIS

 I POP G QUEX

 I $D(IO("Q")),IO=IO(0) W !!,"Sorry, you cannot queue to your screen or to a slave printer.",! K IO("Q") G QUE

 S APSPDRP("IOP")=ION_";"_IOM

 I IO=IO(0)!('$D(IO("Q"))) D ^%ZISC G QUEX

 D ^%ZISC

 S ZTRTN="EN^APSPDRP",ZTSAVE("APSPDRP(""BD"")")=""

 S ZTSAVE("APSPDRP(""DFN'S"",")=""

 S ZTSAVE("APSPDRP(""ED"")")="",ZTIO="",ZTSAVE("APSPDRP(""IOP"")")=""

 S ZTDESC="PHARMACY DUE REVIEWS"

 D ^%ZTLOAD

 S:'$D(ZTSK) POP=1

QUEX Q

 ;------------------------------------------------------------------

BODY ;

 F APSPII=(APSPDRP("BD")-1):0 S APSPII=$O(^APSPDUE(32,"B",APSPII)) Q:APSPII>APSPDRP("ED")!('APSPII)  D SORT

 K APSPII

 I $D(ZTQUEUED) S ZTREQ="@" D QUE2 G BODYX

 D ^APSPDRP1

BODYX Q

 ;-------------------------------------------------------------------

SORT ;

 F APSPDRP("DA")=0:0 S APSPDRP("DA")=$O(^APSPDUE(32,"B",APSPII,APSPDRP("DA"))) Q:'APSPDRP("DA")  I $D(^APSPDUE(32,APSPDRP("DA"),0)),$D(APSPDRP("DFN'S",$P(^(0),U,2))) D

 . S ^TMP("APSPDRP1",$J,$P(^APSPDUE(32,APSPDRP("DA"),0),U,2),APSPII,$P(^(0),U,3),APSPDRP("DA"))=""

 . Q

 Q

QUE2 ;

 S ZTDTH=$H

 S ZTRTN="^APSPDRP1",ZTSAVE("APSPDRP(""BD"")")=""

 S ZTSAVE("^TMP(""APSPDRP1"",$J,")=""

 S ZTSAVE("APSPDRP(""ED"")")="",ZTSAVE("APSPDRP(""IOP"")")=""

 S ZTDESC="PRINT PHARMACY DUE REVIEWS"

 S ZTIO=APSPDRP("IOP")

 D ^%ZTLOAD

 Q

EOJ ;

 K APSPDRP,APSPII,ZTSK,ZTSAVE,ZTIO,IOP,IOQ,POP

 K ZTRTN,ZTDESC,%ZIS

 Q

APSPDRP   ; IHS/DSD/ENM - SORT ENTRIES FROM DUE REVIEW FILE ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;------------------------------------------------------------

START     ;

 +1       ; Ask Beginning and Ending Dates

           DO BD

 +2        IF '$DATA(APSPDRP("ED"))

               GOTO END

 +3       ;Select the DUE Study

           DO DIC

 +4        IF '$DATA(APSPDRP("DFN'S"))

               GOTO END

 +5       ;Ask Device

           DO QUE

 +6        IF POP!($DATA(IOQ))

               GOTO END

EN        ;Main driver for rest of routine

           DO BODY

END       ; Clean up local variables

           DO EOJ

 +1        QUIT 

 +2       ;--------------------------------------------------------------

BD        ;

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

 +2        SET %DT("A")="PLEASE ENTER BEGINNING DATE: "

 +3        SET %DT="AE"

 +4        DO ^%DT

 +5        IF Y=-1

               GOTO BDX

 +6        SET APSPDRP("BD")=Y

 +7        SET %DT("A")="PLEASE ENTER ENDING DATE: "

 +8        DO ^%DT

 +9        IF Y=-1

               IF X=""

                   GOTO BD

               GOTO BDX

 +10       SET APSPDRP("ED")=Y_".999999"

BDX        QUIT 

 +1       ;

DIC       ;

 +1        SET DIC="^APSPDUE(32.1,"

 +2        SET DIC(0)="AEQM"

 +3        DO ^DIC

           KILL DIC,DR

 +4        IF Y>0

               IF '$DATA(^APSPDUE(32,"D",+Y))

                   WRITE !,"No Review's on File for this Study..",!

                   SET DIC("A")="ANOTHER ONE: "

                   GOTO DIC

 +5        IF Y>0

               SET APSPDRP("DFN'S",+Y)=""

               SET DIC("A")="ANOTHER ONE: "

               GOTO DIC

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))

               KILL APSPDRP("DFN'S")

 +7        QUIT 

QUE       ;

 +1        WRITE !

 +2        SET %ZIS="QMN"

 +3        DO ^%ZIS

 +4        IF POP

               GOTO QUEX

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

               IF IO=IO(0)

                   WRITE !!,"Sorry, you cannot queue to your screen or to a slave printer.",!

                   KILL IO("Q")

                   GOTO QUE

 +6        SET APSPDRP("IOP")=ION_";"_IOM

 +7        IF IO=IO(0)!('$DATA(IO("Q")))

               DO ^%ZISC

               GOTO QUEX

 +8        DO ^%ZISC

 +9        SET ZTRTN="EN^APSPDRP"

           SET ZTSAVE("APSPDRP(""BD"")")=""

 +10       SET ZTSAVE("APSPDRP(""DFN'S"",")=""

 +11       SET ZTSAVE("APSPDRP(""ED"")")=""

           SET ZTIO=""

           SET ZTSAVE("APSPDRP(""IOP"")")=""

 +12       SET ZTDESC="PHARMACY DUE REVIEWS"

 +13       DO ^%ZTLOAD

 +14       IF '$DATA(ZTSK)

               SET POP=1

QUEX       QUIT 

 +1       ;------------------------------------------------------------------

BODY      ;

 +1        FOR APSPII=(APSPDRP("BD")-1):0

               SET APSPII=$ORDER(^APSPDUE(32,"B",APSPII))

               IF APSPII>APSPDRP("ED")!('APSPII)

                   QUIT 

               DO SORT

 +2        KILL APSPII

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               DO QUE2

               GOTO BODYX

 +4        DO ^APSPDRP1

BODYX      QUIT 

 +1       ;-------------------------------------------------------------------

SORT      ;

 +1        FOR APSPDRP("DA")=0:0

               SET APSPDRP("DA")=$ORDER(^APSPDUE(32,"B",APSPII,APSPDRP("DA")))

               IF 'APSPDRP("DA")

                   QUIT 

               IF $DATA(^APSPDUE(32,APSPDRP("DA"),0))

                   IF $DATA(APSPDRP("DFN'S",$PIECE(^(0),U,2)))

                       Begin DoDot:1

 +2                        SET ^TMP("APSPDRP1",$JOB,$PIECE(^APSPDUE(32,APSPDRP("DA"),0),U,2),APSPII,$PIECE(^(0),U,3),APSPDRP("DA"))=""

 +3                        QUIT 

                       End DoDot:1

 +4        QUIT 

QUE2      ;

 +1        SET ZTDTH=$HOROLOG

 +2        SET ZTRTN="^APSPDRP1"

           SET ZTSAVE("APSPDRP(""BD"")")=""

 +3        SET ZTSAVE("^TMP(""APSPDRP1"",$J,")=""

 +4        SET ZTSAVE("APSPDRP(""ED"")")=""

           SET ZTSAVE("APSPDRP(""IOP"")")=""

 +5        SET ZTDESC="PRINT PHARMACY DUE REVIEWS"

 +6        SET ZTIO=APSPDRP("IOP")

 +7        DO ^%ZTLOAD

 +8        QUIT 

EOJ       ;

 +1        KILL APSPDRP,APSPII,ZTSK,ZTSAVE,ZTIO,IOP,IOQ,POP

 +2        KILL ZTRTN,ZTDESC,%ZIS

 +3        QUIT