Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODISP2

PSODISP2.m

Go to the documentation of this file.
  1. PSODISP2 ;BHAM ISC/SAB - report of released scripts ; 03/29/93 16:49
  1. ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
  1. 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
  1. .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
  1. ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",19),DUD Q
  1. ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",9)'=SITE Q
  1. ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",16)]"" Q
  1. ..S XY=$P(^PSRX(RXN,"STA"),"^") I (XY=3)!(XY=4)!(XY=13) Q
  1. ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",19) D D CP1^PSODISP1
  1. ...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"
  1. ..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
  1. ...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
  1. Q