- 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
