- 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 Feb 18, 2025@23:53:35 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