| 1 | PSOSUBCH ;BIR/RTR-Print batch list to a printer ; 1/1/96
 | 
|---|
| 2 |  ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
 | 
|---|
| 3 | QUE K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I POP W !,"NOTHING PRINTED" Q
 | 
|---|
| 4 |  I $E(IOST)'["P" W !!,"This report must be sent to a printer!",! G QUE
 | 
|---|
| 5 |  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
 | 
|---|
| 6 |  D MSNQ
 | 
|---|
| 7 | LIST U IO S SBFLAG=0 F LLL=0:0 S LLL=$O(^TMP($J,"PSORESPR",LLL)) Q:'LLL  D
 | 
|---|
| 8 |  .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
 | 
|---|
| 9 |  ..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
 | 
|---|
| 10 |  ...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
 | 
|---|
| 11 |  ...D:$Y+5>IOSL HEAD
 | 
|---|
| 12 |  I '$G(SBFLAG) W !!,"No Rx's to print!",!
 | 
|---|
| 13 |  W !!,"END OF LIST"
 | 
|---|
| 14 |  G END
 | 
|---|
| 15 | 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
 | 
|---|
| 16 |  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 "-"
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 | 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
 | 
|---|
| 19 | DEQUE K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I POP Q
 | 
|---|
| 20 |  I $E(IOST)'["P" W !!,"This report must be sent to a printer!",! G DEQUE
 | 
|---|
| 21 |  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
 | 
|---|
| 22 |  D MSNQ
 | 
|---|
| 23 | DELIST U IO S SBFLAG=0 F LLL=0:0 S LLL=$O(^TMP($J,"PSODESPR",LLL)) Q:'LLL  D
 | 
|---|
| 24 |  .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
 | 
|---|
| 25 |  ..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
 | 
|---|
| 26 |  ...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
 | 
|---|
| 27 |  ...D:$Y+5>IOSL DEHEAD
 | 
|---|
| 28 |  I '$G(SBFLAG) W !!,"No Rx's to print!",!
 | 
|---|
| 29 |  W !!,"END OF LIST"
 | 
|---|
| 30 |  G DEEND
 | 
|---|
| 31 | 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
 | 
|---|
| 32 |  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 "-"
 | 
|---|
| 33 |  Q
 | 
|---|
| 34 | 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
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 | MSQ W !!,"REPORT of batched Rx's queued to print!",! Q
 | 
|---|
| 37 | MSNQ W !!,"REPORT of batched Rx's being sent to print!",! Q
 | 
|---|