PSOSUBCH ;BIR/RTR-Print batch list to a printer ; 1/1/96
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
QUE K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I POP W !,"NOTHING PRINTED" Q
I $E(IOST)'["P" W !!,"This report must be sent to a printer!",! G QUE
I $D(IO("Q")) S ZTRTN="LIST^PSOSUBCH",ZTDESC="Report of printed suspense batch",ZTSAVE("^TMP($J,""PSORES"",")="",ZTSAVE("^TMP($J,""PSORESPR"",")="",ZTSAVE("PSOSITE")="" D ^%ZTLOAD,MSQ D ^%ZISC Q
D MSNQ
LIST U IO S SBFLAG=0 F LLL=0:0 S LLL=$O(^TMP($J,"PSORESPR",LLL)) Q:'LLL D
.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 D
..F GG=0:0 S GG=$O(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS,GG)) Q:'GG 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:"") S SBFLAG=1
...D:$Y+5>IOSL HEAD
I '$G(SBFLAG) W !!,"No Rx's to print!",!
W !!,"END OF LIST"
G END
HEAD S PSOPTIME=$O(^TMP($J,"PSORES",LLL,0)),PSOPDUZ=$O(^TMP($J,"PSORES",LLL,PSOPTIME,0)) S Y=PSOPTIME X ^DD("DD") S PSOPTIME=Y
W @IOF W !,"ORIGINALLY QUEUED FOR ",$G(PSOPTIME)," BY ",$S($D(^VA(200,+$G(PSOPDUZ),0)):$E($P(^(0),"^"),1,31),1:"UNKNOWN"),!,"RX #",?20,"PATIENT NAME",?51,"SUSPENSE BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
Q
END W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J,"PSORES"),^TMP($J,"PSORESPR"),REDT,REDUZ,SS,GG,INRX,LLL,ZZZZ,PSOPTIME,PSOPDUZ Q
DEQUE K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I POP Q
I $E(IOST)'["P" W !!,"This report must be sent to a printer!",! G DEQUE
I $D(IO("Q")) S ZTRTN="DELIST^PSOSUBCH",ZTDESC="Report of printed suspense batch",ZTSAVE("^TMP($J,""PSODES"",")="",ZTSAVE("^TMP($J,""PSODESPR"",")="",ZTSAVE("PSOSITE")="" D ^%ZTLOAD,MSQ D ^%ZISC Q
D MSNQ
DELIST U IO S SBFLAG=0 F LLL=0:0 S LLL=$O(^TMP($J,"PSODESPR",LLL)) Q:'LLL D
.D DEHEAD S REDT=$O(^TMP($J,"PSODES",LLL,0)),REDUZ=$O(^TMP($J,"PSODES",LLL,REDT,0)) S RESITE=$O(^TMP($J,"PSODES",LLL,REDT,REDUZ,0)) F SS=0:0 S SS=$O(^PS(52.5,"AS",REDT,REDUZ,RESITE,SS)) Q:'SS D
..F GG=0:0 S GG=$O(^PS(52.5,"AS",REDT,REDUZ,RESITE,SS,GG)) Q:'GG I $D(^PS(52.5,GG,0)) 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:"") S SBFLAG=1
...D:$Y+5>IOSL DEHEAD
I '$G(SBFLAG) W !!,"No Rx's to print!",!
W !!,"END OF LIST"
G DEEND
DEHEAD S PSOPTIME=$O(^TMP($J,"PSODES",LLL,0)),PSOPDUZ=$O(^TMP($J,"PSODES",LLL,PSOPTIME,0)) S Y=PSOPTIME X ^DD("DD") S PSOPTIME=Y
W @IOF W !,"ORIGINALLY QUEUED FOR ",$G(PSOPTIME)," BY ",$S($D(^VA(200,+$G(PSOPDUZ),0)):$E($P(^(0),"^"),1,31),1:"UNKNOWN"),!,"RX #",?20,"PATIENT NAME",?51,"SUSPENSE BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
Q
DEEND W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J,"PSODES"),^TMP($J,"PSODESPR"),SBFLAG,LLL,ZZZZ,REDT,REDUZ,RESITE,SS,GG,INRX,PSOPTIME,PSOPDUZ
Q
MSQ W !!,"REPORT of batched Rx's queued to print!",! Q
MSNQ W !!,"REPORT of batched Rx's being sent to print!",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSUBCH 3184 printed Apr 09, 2024@21:33:09 Page 2
PSOSUBCH ;BIR/RTR-Print batch list to a printer ; 1/1/96
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
QUE KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF POP
WRITE !,"NOTHING PRINTED"
QUIT
+1 IF $EXTRACT(IOST)'["P"
WRITE !!,"This report must be sent to a printer!",!
GOTO QUE
+2 IF $DATA(IO("Q"))
SET ZTRTN="LIST^PSOSUBCH"
SET ZTDESC="Report of printed suspense batch"
SET ZTSAVE("^TMP($J,""PSORES"",")=""
SET ZTSAVE("^TMP($J,""PSORESPR"",")=""
SET ZTSAVE("PSOSITE")=""
DO ^%ZTLOAD
DO MSQ
DO ^%ZISC
QUIT
+3 DO MSNQ
LIST USE IO
SET SBFLAG=0
FOR LLL=0:0
SET LLL=$ORDER(^TMP($JOB,"PSORESPR",LLL))
if 'LLL
QUIT
Begin DoDot:1
+1 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
QUIT
Begin DoDot:2
+2 FOR GG=0:0
SET GG=$ORDER(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS,GG))
if 'GG
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:"")
SET SBFLAG=1
+4 if $Y+5>IOSL
DO HEAD
End DoDot:3
End DoDot:2
End DoDot:1
+5 IF '$GET(SBFLAG)
WRITE !!,"No Rx's to print!",!
+6 WRITE !!,"END OF LIST"
+7 GOTO END
HEAD SET PSOPTIME=$ORDER(^TMP($JOB,"PSORES",LLL,0))
SET PSOPDUZ=$ORDER(^TMP($JOB,"PSORES",LLL,PSOPTIME,0))
SET Y=PSOPTIME
XECUTE ^DD("DD")
SET PSOPTIME=Y
+1 WRITE @IOF
WRITE !,"ORIGINALLY QUEUED FOR ",$GET(PSOPTIME)," BY ",$SELECT($DATA(^VA(200,+$GET(PSOPDUZ),0)):$EXTRACT($PIECE(^(0),"^"),1,31),1:"UNKNOWN"),!,"RX #",?20,"PATIENT NAME",?51,"SUSPENSE BATCH ",LLL,!
FOR ZZZZ=1:1:78
WRITE "-"
+2 QUIT
END WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB,"PSORES"),^TMP($JOB,"PSORESPR"),REDT,REDUZ,SS,GG,INRX,LLL,ZZZZ,PSOPTIME,PSOPDUZ
QUIT
DEQUE KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT
+1 IF $EXTRACT(IOST)'["P"
WRITE !!,"This report must be sent to a printer!",!
GOTO DEQUE
+2 IF $DATA(IO("Q"))
SET ZTRTN="DELIST^PSOSUBCH"
SET ZTDESC="Report of printed suspense batch"
SET ZTSAVE("^TMP($J,""PSODES"",")=""
SET ZTSAVE("^TMP($J,""PSODESPR"",")=""
SET ZTSAVE("PSOSITE")=""
DO ^%ZTLOAD
DO MSQ
DO ^%ZISC
QUIT
+3 DO MSNQ
DELIST USE IO
SET SBFLAG=0
FOR LLL=0:0
SET LLL=$ORDER(^TMP($JOB,"PSODESPR",LLL))
if 'LLL
QUIT
Begin DoDot:1
+1 DO DEHEAD
SET REDT=$ORDER(^TMP($JOB,"PSODES",LLL,0))
SET REDUZ=$ORDER(^TMP($JOB,"PSODES",LLL,REDT,0))
SET RESITE=$ORDER(^TMP($JOB,"PSODES",LLL,REDT,REDUZ,0))
FOR SS=0:0
SET SS=$ORDER(^PS(52.5,"AS",REDT,REDUZ,RESITE,SS))
if 'SS
QUIT
Begin DoDot:2
+2 FOR GG=0:0
SET GG=$ORDER(^PS(52.5,"AS",REDT,REDUZ,RESITE,SS,GG))
if 'GG
QUIT
IF $DATA(^PS(52.5,GG,0))
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:"")
SET SBFLAG=1
+4 if $Y+5>IOSL
DO DEHEAD
End DoDot:3
End DoDot:2
End DoDot:1
+5 IF '$GET(SBFLAG)
WRITE !!,"No Rx's to print!",!
+6 WRITE !!,"END OF LIST"
+7 GOTO DEEND
DEHEAD SET PSOPTIME=$ORDER(^TMP($JOB,"PSODES",LLL,0))
SET PSOPDUZ=$ORDER(^TMP($JOB,"PSODES",LLL,PSOPTIME,0))
SET Y=PSOPTIME
XECUTE ^DD("DD")
SET PSOPTIME=Y
+1 WRITE @IOF
WRITE !,"ORIGINALLY QUEUED FOR ",$GET(PSOPTIME)," BY ",$SELECT($DATA(^VA(200,+$GET(PSOPDUZ),0)):$EXTRACT($PIECE(^(0),"^"),1,31),1:"UNKNOWN"),!,"RX #",?20,"PATIENT NAME",?51,"SUSPENSE BATCH ",LLL,!
FOR ZZZZ=1:1:78
WRITE "-"
+2 QUIT
DEEND WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB,"PSODES"),^TMP($JOB,"PSODESPR"),SBFLAG,LLL,ZZZZ,REDT,REDUZ,RESITE,SS,GG,INRX,PSOPTIME,PSOPDUZ
+1 QUIT
MSQ WRITE !!,"REPORT of batched Rx's queued to print!",!
QUIT
MSNQ WRITE !!,"REPORT of batched Rx's being sent to print!",!
QUIT
