PSODISP2 ;BHAM ISC/SAB - report of released scripts ; 03/29/93 16:49
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
S (RXN,ND)=0,BDT=BEGDT-1 F S BDT=$O(^PSRX("ADP",BDT)) Q:'BDT!(BDT>ENDDT) F S RXN=$O(^PSRX("ADP",BDT,RXN)) Q:'RXN D
.F S ND=$O(^PSRX("ADP",BDT,RXN,ND)) Q:'ND!($G(^PSRX(RXN,0))']"") S PAR=1,NODE=ND D K LB,LBLP I $Y+4>IOSL D HD^PSODISP1
..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",19),DUD Q
..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",9)'=SITE Q
..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",16)]"" Q
..S XY=$P(^PSRX(RXN,"STA"),"^") I (XY=3)!(XY=4)!(XY=13) Q
..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",19) D D CP1^PSODISP1
...W !,$P(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE S Y=$P(^PSRX(RXN,"P",NODE,0),"^",19) X ^DD("DD") W ?29,$S(Y["@":$P(Y,"@"),1:Y),?50,"Yes"
..I '$P(^PSRX(RXN,"P",NODE,0),"^",19) D Q:'$G(LBLP) W !,$P(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE,?50,"No" D CP1^PSODISP1 S UNREL=UNREL+1 K LBLP
...F LB=0:0 S LB=$O(^PSRX(RXN,"L",LB)) Q:'LB I $P(^PSRX(RXN,"L",LB,0),"^",2)=(99-NODE) S LBLP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODISP2 1014 printed Dec 13, 2024@02:27:08 Page 2
PSODISP2 ;BHAM ISC/SAB - report of released scripts ; 03/29/93 16:49
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 SET (RXN,ND)=0
SET BDT=BEGDT-1
FOR
SET BDT=$ORDER(^PSRX("ADP",BDT))
if 'BDT!(BDT>ENDDT)
QUIT
FOR
SET RXN=$ORDER(^PSRX("ADP",BDT,RXN))
if 'RXN
QUIT
Begin DoDot:1
+3 FOR
SET ND=$ORDER(^PSRX("ADP",BDT,RXN,ND))
if 'ND!($GET(^PSRX(RXN,0))']"")
QUIT
SET PAR=1
SET NODE=ND
Begin DoDot:2
+4 IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",19)
IF DUD
QUIT
+5 IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",9)'=SITE
QUIT
+6 IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",16)]""
QUIT
+7 SET XY=$PIECE(^PSRX(RXN,"STA"),"^")
IF (XY=3)!(XY=4)!(XY=13)
QUIT
+8 IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",19)
Begin DoDot:3
+9 WRITE !,$PIECE(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE
SET Y=$PIECE(^PSRX(RXN,"P",NODE,0),"^",19)
XECUTE ^DD("DD")
WRITE ?29,$SELECT(Y["@":$PIECE(Y,"@"),1:Y),?50,"Yes"
End DoDot:3
DO CP1^PSODISP1
+10 IF '$PIECE(^PSRX(RXN,"P",NODE,0),"^",19)
Begin DoDot:3
+11 FOR LB=0:0
SET LB=$ORDER(^PSRX(RXN,"L",LB))
if 'LB
QUIT
IF $PIECE(^PSRX(RXN,"L",LB,0),"^",2)=(99-NODE)
SET LBLP=1
End DoDot:3
if '$GET(LBLP)
QUIT
WRITE !,$PIECE(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE,?50,"No"
DO CP1^PSODISP1
SET UNREL=UNREL+1
KILL LBLP
End DoDot:2
KILL LB,LBLP
IF $Y+4>IOSL
DO HD^PSODISP1
End DoDot:1
+12 QUIT
