- PSOSURST ;BIR/RTR-Reset and Reprint from Suspense ; 7/20/96
- ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
- D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) G END
- N X S X="PSXRPPL1" X ^%ZOSF("TEST") K X G:'$T START
- G:$G(PSXSYS)&($D(^XUSEC("PSXCMOPMGR",DUZ)))&($D(^XUSEC("PSX XMIT",DUZ))) ^PSXRPPL1
- START W !!,"Enter a date range to see all batches printed from suspense within those dates."
- BEG K ^TMP($J,"PSORES"),^TMP($J,"PSORESPR"),^UTILITY($J,"PSOREPT"),PSOOUT,DTOUT,PSOLISTY
- W ! K %DT S %DT="AEX",%DT("A")="Start date: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END S (%DT(0),BEGDATE)=Y W ! S %DT="AEX",%DT("A")="End date: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END S ENDDATE=Y
- S BEGDATE=BEGDATE-.0001,ENDDATE=ENDDATE+.9999,RECNT=1 W !!,"Gathering batches, please wait...",! H 1
- F ZZZ=BEGDATE:0 S ZZZ=$O(^PS(52.5,"AS",ZZZ)) Q:'ZZZ!(ZZZ>ENDDATE) F XXX=0:0 S XXX=$O(^PS(52.5,"AS",ZZZ,XXX)) Q:'XXX F MMM=0:0 S MMM=$O(^PS(52.5,"AS",ZZZ,XXX,MMM)) Q:'MMM D
- .I MMM=$G(PSOSITE) S ^TMP($J,"PSORES",RECNT,ZZZ,XXX,MMM)="",RECNT=RECNT+1
- I '$D(^TMP($J,"PSORES")) W $C(7),!!,"There are no printed batches found for that date range!",! G BEG
- H 1 W @IOF W !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$E($P($G(^PS(59,PSOSITE,0)),"^"),1,23),! F AA=1:1:78 W "-"
- W ! F AAA=0:0 S AAA=$O(^TMP($J,"PSORES",AAA)) Q:'AAA!($G(PSOOUT)) S PSIDATE=$O(^TMP($J,"PSORES",AAA,0)),PSODUZ=$O(^TMP($J,"PSORES",AAA,PSIDATE,0)) D
- .S Y=PSIDATE X ^DD("DD") S PSODATE=Y,PSOUSER=$S($D(^VA(200,PSODUZ,0)):$P($G(^(0)),"^"),1:"UNKNOWN") D:($Y+5)>IOSL Q:$G(PSOOUT) W !?2,AAA,?10,PSODATE,?40,PSOUSER
- ..W ! K DIR S DIR(0)="E" D ^DIR K DIR S:'Y PSOOUT=1 I Y W @IOF W !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$E($P($G(^PS(59,PSOSITE,0)),"^"),1,23),! F AA=1:1:78 W "-"
- I $G(PSOOUT),Y="" G END
- S RECNT=RECNT-1,PSOOUT=0 W ! K DIR S DIR("A")="Select Batch(s) to reprint",DIR(0)="L^1:"_RECNT D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!?3,"Nothing queued to print!",! G START
- S COUNT=1 F ZZ=1:1:$L(Y) S ZZZ=$E(Y,ZZ) I ZZZ="," S COUNT=COUNT+1
- S COUNT=COUNT-1 F JJ=1:1:COUNT S RR=$P(Y,",",JJ),^TMP($J,"PSORESPR",RR)=""
- YLOOP I $G(Y(1)) F PSYLOOP=0:0 S PSYLOOP=$O(Y(PSYLOOP)) Q:'PSYLOOP D
- .S COUNT=1 F ZZ=1:1:$L(Y(PSYLOOP)) S ZZZ=$E(Y(PSYLOOP),ZZ) I ZZZ="," S COUNT=COUNT+1
- .S COUNT=COUNT-1 F JJ=1:1:COUNT S RR=$P(Y(PSYLOOP),",",JJ),^TMP($J,"PSORESPR",RR)=""
- W !!,"Batches selected for Reprint are:",! F ZZZ=0:0 S ZZZ=$O(^TMP($J,"PSORESPR",ZZZ)) Q:'ZZZ D
- .S PSIDATE=$O(^TMP($J,"PSORES",ZZZ,0)),PSODUZ=$O(^TMP($J,"PSORES",ZZZ,PSIDATE,0)) S Y=PSIDATE X ^DD("DD") S PSODATE=Y,PSOUSER=$S($D(^VA(200,PSODUZ,0)):$P($G(^(0)),"^"),1:"UNKNOWN")
- .W !,"Batch ",ZZZ," Queued for ",PSODATE," by ",PSOUSER
- W ! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Before Reprinting, would you like a list of these prescriptions" D ^DIR K DIR I Y["^"!($D(DTOUT)) W !!?3,"Nothing queued to print!",! G START
- I Y W ! S PSOLISTY=1 S DIR(0)="SB^S:SCREEN;P:PRINTER",DIR("A")="Print list to the screen or to a printer",DIR("B")="Screen" D ^DIR K DIR I $D(DIRUT) W !!?3,"Nothing queued to print!",! G START
- I $G(PSOLISTY),Y="P" D ^PSOSUBCH G START
- I $G(PSOLISTY) D LIST I $G(PSOOUT) G START
- QUE W ! K %DT D NOW^%DTC S %DT="REAX",%DT(0)=%,%DT("B")="NOW",%DT("A")="Queue labels to reprint at what time: " D ^%DT K %DT I $D(DTOUT)!(Y<0) W !!?3,"Nothing queued to print!",! G START
- S PSOSUREP=1,PSORTIME=Y
- W ! S %ZIS("A")="REPRINT LABEL DEVICE: ",%ZIS("B")="",%ZIS="MQN" D ^%ZIS I POP!($E(IOST)["C") G START
- N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST
- S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19)
- S PSOREDEV=ION
- S ZTRTN="BEG^PSOSUSRP",ZTDTH=PSORTIME,ZTIO=PSOREDEV,ZTDESC="REPRINT LABELS FROM SUSPENSE"
- F GG="PSOPAR","PSOSYS","PSOSITE","PSOSUREP","PSOBARS","PSOBAR0","PSOBAR1" S:$D(@GG) ZTSAVE(GG)=""
- F NNN=0:0 S NNN=$O(^TMP($J,"PSORESPR",NNN)) Q:'NNN D
- .S PSRDATE=$O(^TMP($J,"PSORES",NNN,0)),PSRDUZ=$O(^TMP($J,"PSORES",NNN,PSRDATE,0)),PSRDIV=$O(^TMP($J,"PSORES",NNN,PSRDATE,PSRDUZ,0))
- .S ^UTILITY($J,"PSOREPT",PSRDATE,PSRDUZ,PSRDIV)=""
- S ZTSAVE("^UTILITY($J,""PSOREPT"",")="" D ^%ZTLOAD
- W !!,"REPRINTED LABELS QUEUED TO PRINT!",!
- END K ^TMP($J,"PSORES"),^TMP($J,"PSORESPR"),^UTILITY($J,"PSOREPT"),%DT,%ZIS,AA,AAA,BEGDATE,COUNT,DUOUT,DTOUT,ENDDATE,GG,INRX,JJ,LLL,MMM,NNN,POP,PSIDATE,PSODATE,PSODUZ,PSOREDEV,PSORTIME,PSOSUREP,PSOUSER,PSYLOOP
- K PSRDATE,PSRDIV,PSOLISTY,PSRDUZ,RECNT,REDT,REDUZ,RR,SS,XXX,ZZ,ZZZ,ZZZ D ^%ZISC Q
- LIST F LLL=0:0 S LLL=$O(^TMP($J,"PSORESPR",LLL)) Q:'LLL!($G(PSOOUT)) D
- .W ! S DIR(0)="E" D ^DIR K DIR S:'Y PSOOUT=1 Q:$G(PSOOUT) D HEAD S REDT=$O(^TMP($J,"PSORES",LLL,0)),REDUZ=$O(^TMP($J,"PSORES",LLL,REDT,0)) F SS=0:0 S SS=$O(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS)) Q:'SS!($G(PSOOUT)) D
- ..F GG=0:0 S GG=$O(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS,GG)) Q:'GG!($G(PSOOUT)) D:($Y+5)>IOSL HEADONE Q:$G(PSOOUT) I $D(^PS(52.5,GG,0)),$P($G(^(0)),"^",6)=PSOSITE S INRX=$P(^(0),"^") I $D(^PSRX(INRX,0)) D
- ...W !,$P(^PSRX(INRX,0),"^"),?20,$P($G(^DPT(+$P(^PSRX(INRX,0),"^",2),0)),"^"),?60,$S($P($G(^PS(52.5,GG,0)),"^",5):"(PARTIAL)",$P($G(^(0)),"^",12):"(REPRINT)",1:"")
- I $G(PSOOUT),(Y="") Q
- S PSOOUT=0 I Y'=0 W !,"END OF LIST"
- Q
- HEAD W @IOF W !,"RX #",?20,"PATIENT NAME",?60,"BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
- Q
- HEADONE S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
- W @IOF W !,"RX #",?20,"PATIENT NAME",?60,"BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
- Q
- PSOSURST ;BIR/RTR-Reset and Reprint from Suspense ; 7/20/96
- +1 ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
- +2 IF '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- GOTO END
- +3 NEW X
- SET X="PSXRPPL1"
- XECUTE ^%ZOSF("TEST")
- KILL X
- IF '$TEST
- GOTO START
- +4 IF $GET(PSXSYS)&($DATA(^XUSEC("PSXCMOPMGR",DUZ)))&($DATA(^XUSEC("PSX XMIT",DUZ)))
- GOTO ^PSXRPPL1
- START WRITE !!,"Enter a date range to see all batches printed from suspense within those dates."
- BEG KILL ^TMP($JOB,"PSORES"),^TMP($JOB,"PSORESPR"),^UTILITY($JOB,"PSOREPT"),PSOOUT,DTOUT,PSOLISTY
- +1 WRITE !
- KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Start date: "
- DO ^%DT
- KILL %DT
- IF Y<0!($DATA(DTOUT))
- GOTO END
- SET (%DT(0),BEGDATE)=Y
- WRITE !
- SET %DT="AEX"
- SET %DT("A")="End date: "
- DO ^%DT
- KILL %DT
- IF Y<0!($DATA(DTOUT))
- GOTO END
- SET ENDDATE=Y
- +2 SET BEGDATE=BEGDATE-.0001
- SET ENDDATE=ENDDATE+.9999
- SET RECNT=1
- WRITE !!,"Gathering batches, please wait...",!
- HANG 1
- +3 FOR ZZZ=BEGDATE:0
- SET ZZZ=$ORDER(^PS(52.5,"AS",ZZZ))
- IF 'ZZZ!(ZZZ>ENDDATE)
- QUIT
- FOR XXX=0:0
- SET XXX=$ORDER(^PS(52.5,"AS",ZZZ,XXX))
- IF 'XXX
- QUIT
- FOR MMM=0:0
- SET MMM=$ORDER(^PS(52.5,"AS",ZZZ,XXX,MMM))
- IF 'MMM
- QUIT
- Begin DoDot:1
- +4 IF MMM=$GET(PSOSITE)
- SET ^TMP($JOB,"PSORES",RECNT,ZZZ,XXX,MMM)=""
- SET RECNT=RECNT+1
- End DoDot:1
- +5 IF '$DATA(^TMP($JOB,"PSORES"))
- WRITE $CHAR(7),!!,"There are no printed batches found for that date range!",!
- GOTO BEG
- +6 HANG 1
- WRITE @IOF
- WRITE !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$EXTRACT($PIECE($GET(^PS(59,PSOSITE,0)),"^"),1,23),!
- FOR AA=1:1:78
- WRITE "-"
- +7 WRITE !
- FOR AAA=0:0
- SET AAA=$ORDER(^TMP($JOB,"PSORES",AAA))
- IF 'AAA!($GET(PSOOUT))
- QUIT
- SET PSIDATE=$ORDER(^TMP($JOB,"PSORES",AAA,0))
- SET PSODUZ=$ORDER(^TMP($JOB,"PSORES",AAA,PSIDATE,0))
- Begin DoDot:1
- +8 SET Y=PSIDATE
- XECUTE ^DD("DD")
- SET PSODATE=Y
- SET PSOUSER=$SELECT($DATA(^VA(200,PSODUZ,0)):$PIECE($GET(^(0)),"^"),1:"UNKNOWN")
- IF ($Y+5)>IOSL
- Begin DoDot:2
- +9 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSOOUT=1
- IF Y
- WRITE @IOF
- WRITE !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$EXTRACT($PIECE($GET(^PS(59,PSOSITE,0)),"^"),1,23),!
- FOR AA=1:1:78
- WRITE "-"
- End DoDot:2
- IF $GET(PSOOUT)
- QUIT
- WRITE !?2,AAA,?10,PSODATE,?40,PSOUSER
- End DoDot:1
- +10 IF $GET(PSOOUT)
- IF Y=""
- GOTO END
- +11 SET RECNT=RECNT-1
- SET PSOOUT=0
- WRITE !
- KILL DIR
- SET DIR("A")="Select Batch(s) to reprint"
- SET DIR(0)="L^1:"_RECNT
- DO ^DIR
- KILL DIR
- IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
- WRITE !!?3,"Nothing queued to print!",!
- GOTO START
- +12 SET COUNT=1
- FOR ZZ=1:1:$LENGTH(Y)
- SET ZZZ=$EXTRACT(Y,ZZ)
- IF ZZZ=","
- SET COUNT=COUNT+1
- +13 SET COUNT=COUNT-1
- FOR JJ=1:1:COUNT
- SET RR=$PIECE(Y,",",JJ)
- SET ^TMP($JOB,"PSORESPR",RR)=""
- YLOOP IF $GET(Y(1))
- FOR PSYLOOP=0:0
- SET PSYLOOP=$ORDER(Y(PSYLOOP))
- IF 'PSYLOOP
- QUIT
- Begin DoDot:1
- +1 SET COUNT=1
- FOR ZZ=1:1:$LENGTH(Y(PSYLOOP))
- SET ZZZ=$EXTRACT(Y(PSYLOOP),ZZ)
- IF ZZZ=","
- SET COUNT=COUNT+1
- +2 SET COUNT=COUNT-1
- FOR JJ=1:1:COUNT
- SET RR=$PIECE(Y(PSYLOOP),",",JJ)
- SET ^TMP($JOB,"PSORESPR",RR)=""
- End DoDot:1
- +3 WRITE !!,"Batches selected for Reprint are:",!
- FOR ZZZ=0:0
- SET ZZZ=$ORDER(^TMP($JOB,"PSORESPR",ZZZ))
- IF 'ZZZ
- QUIT
- Begin DoDot:1
- +4 SET PSIDATE=$ORDER(^TMP($JOB,"PSORES",ZZZ,0))
- SET PSODUZ=$ORDER(^TMP($JOB,"PSORES",ZZZ,PSIDATE,0))
- SET Y=PSIDATE
- XECUTE ^DD("DD")
- SET PSODATE=Y
- SET PSOUSER=$SELECT($DATA(^VA(200,PSODUZ,0)):$PIECE($GET(^(0)),"^"),1:"UNKNOWN")
- +5 WRITE !,"Batch ",ZZZ," Queued for ",PSODATE," by ",PSOUSER
- End DoDot:1
- +6 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="N"
- SET DIR("A")="Before Reprinting, would you like a list of these prescriptions"
- DO ^DIR
- KILL DIR
- IF Y["^"!($DATA(DTOUT))
- WRITE !!?3,"Nothing queued to print!",!
- GOTO START
- +7 IF Y
- WRITE !
- SET PSOLISTY=1
- SET DIR(0)="SB^S:SCREEN;P:PRINTER"
- SET DIR("A")="Print list to the screen or to a printer"
- SET DIR("B")="Screen"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- WRITE !!?3,"Nothing queued to print!",!
- GOTO START
- +8 IF $GET(PSOLISTY)
- IF Y="P"
- DO ^PSOSUBCH
- GOTO START
- +9 IF $GET(PSOLISTY)
- DO LIST
- IF $GET(PSOOUT)
- GOTO START
- QUE WRITE !
- KILL %DT
- DO NOW^%DTC
- SET %DT="REAX"
- SET %DT(0)=%
- SET %DT("B")="NOW"
- SET %DT("A")="Queue labels to reprint at what time: "
- DO ^%DT
- KILL %DT
- IF $DATA(DTOUT)!(Y<0)
- WRITE !!?3,"Nothing queued to print!",!
- GOTO START
- +1 SET PSOSUREP=1
- SET PSORTIME=Y
- +2 WRITE !
- SET %ZIS("A")="REPRINT LABEL DEVICE: "
- SET %ZIS("B")=""
- SET %ZIS="MQN"
- DO ^%ZIS
- IF POP!($EXTRACT(IOST)["C")
- GOTO START
- +3 NEW PSOIOS
- SET PSOIOS=IOS
- DO DEVBAR^PSOBMST
- +4 SET PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$PIECE(PSOPAR,"^",19)
- +5 SET PSOREDEV=ION
- +6 SET ZTRTN="BEG^PSOSUSRP"
- SET ZTDTH=PSORTIME
- SET ZTIO=PSOREDEV
- SET ZTDESC="REPRINT LABELS FROM SUSPENSE"
- +7 FOR GG="PSOPAR","PSOSYS","PSOSITE","PSOSUREP","PSOBARS","PSOBAR0","PSOBAR1"
- IF $DATA(@GG)
- SET ZTSAVE(GG)=""
- +8 FOR NNN=0:0
- SET NNN=$ORDER(^TMP($JOB,"PSORESPR",NNN))
- IF 'NNN
- QUIT
- Begin DoDot:1
- +9 SET PSRDATE=$ORDER(^TMP($JOB,"PSORES",NNN,0))
- SET PSRDUZ=$ORDER(^TMP($JOB,"PSORES",NNN,PSRDATE,0))
- SET PSRDIV=$ORDER(^TMP($JOB,"PSORES",NNN,PSRDATE,PSRDUZ,0))
- +10 SET ^UTILITY($JOB,"PSOREPT",PSRDATE,PSRDUZ,PSRDIV)=""
- End DoDot:1
- +11 SET ZTSAVE("^UTILITY($J,""PSOREPT"",")=""
- DO ^%ZTLOAD
- +12 WRITE !!,"REPRINTED LABELS QUEUED TO PRINT!",!
- END KILL ^TMP($JOB,"PSORES"),^TMP($JOB,"PSORESPR"),^UTILITY($JOB,"PSOREPT"),%DT,%ZIS,AA,AAA,BEGDATE,COUNT,DUOUT,DTOUT,ENDDATE,GG,INRX,JJ,LLL,MMM,NNN,POP,PSIDATE,PSODATE,PSODUZ,PSOREDEV,PSORTIME,PSOSUREP,PSOUSER,PSYLOOP
- +1 KILL PSRDATE,PSRDIV,PSOLISTY,PSRDUZ,RECNT,REDT,REDUZ,RR,SS,XXX,ZZ,ZZZ,ZZZ
- DO ^%ZISC
- QUIT
- LIST FOR LLL=0:0
- SET LLL=$ORDER(^TMP($JOB,"PSORESPR",LLL))
- IF 'LLL!($GET(PSOOUT))
- QUIT
- Begin DoDot:1
- +1 WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSOOUT=1
- IF $GET(PSOOUT)
- QUIT
- DO HEAD
- SET REDT=$ORDER(^TMP($JOB,"PSORES",LLL,0))
- SET REDUZ=$ORDER(^TMP($JOB,"PSORES",LLL,REDT,0))
- FOR SS=0:0
- SET SS=$ORDER(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS))
- IF 'SS!($GET(PSOOUT))
- QUIT
- Begin DoDot:2
- +2 FOR GG=0:0
- SET GG=$ORDER(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS,GG))
- IF 'GG!($GET(PSOOUT))
- QUIT
- IF ($Y+5)>IOSL
- DO HEADONE
- IF $GET(PSOOUT)
- QUIT
- IF $DATA(^PS(52.5,GG,0))
- IF $PIECE($GET(^(0)),"^",6)=PSOSITE
- SET INRX=$PIECE(^(0),"^")
- IF $DATA(^PSRX(INRX,0))
- Begin DoDot:3
- +3 WRITE !,$PIECE(^PSRX(INRX,0),"^"),?20,$PIECE($GET(^DPT(+$PIECE(^PSRX(INRX,0),"^",2),0)),"^"),?60,$SELECT($PIECE($GET(^PS(52.5,GG,0)),"^",5):"(PARTIAL)",$PIECE($GET(^(0)),"^",12):"(REPRINT)",1:"")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +4 IF $GET(PSOOUT)
- IF (Y="")
- QUIT
- +5 SET PSOOUT=0
- IF Y'=0
- WRITE !,"END OF LIST"
- +6 QUIT
- HEAD WRITE @IOF
- WRITE !,"RX #",?20,"PATIENT NAME",?60,"BATCH ",LLL,!
- FOR ZZZZ=1:1:78
- WRITE "-"
- +1 QUIT
- HEADONE SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSOOUT=1
- QUIT
- +1 WRITE @IOF
- WRITE !,"RX #",?20,"PATIENT NAME",?60,"BATCH ",LLL,!
- FOR ZZZZ=1:1:78
- WRITE "-"
- +2 QUIT
