source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBVDLU2.m@ 1328

PSBVDLU2 ;BIRMINGHAM/EFC-BCMA VDL UTILITIES ;Mar 2004
 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
 ;
 ; Reference/IA
 ; EN^PSJBCMA1/2829
 ;
INFUSING ;  determine if there is any bag not completed on an order or its' previous orders
 N PSBSONX,PSBSPONX
 S PSBCOMP=0 K PSBPORA I '$D(PSBPONX) D PSJ1^PSBVT(DFN,PSBONX)
 S PSBPORA(PSBONX,PSBONX)="",PSBSONX=PSBONX,PSBSPONX=PSBPONX I PSBPONX'="",PSBPONX'["P" S PSBPORA(PSBSONX,PSBPONX)=""
 F  Q:(PSBPONX="")!(PSBSONX=PSBPONX)  D  Q:^TMP("PSJ1",$J,0)=-1  S PSBPONX=$P(^(0),"^",4) Q:PSBPONX=""  S PSBSPONX=PSBPONX S:(PSBPONX]"")&(PSBPONX'["P") PSBPORA(PSBSONX,PSBPONX)=""
 .K ^TMP("PSJ1",$J) D EN^PSJBCMA1(DFN,PSBSPONX,1)
 S X="" F  S X=$O(PSBPORA(PSBONX,X)) Q:X=""  D
 .S Y=""  F  S Y=$O(^PSB(53.79,"AUID",PSBDFN,X,Y)) Q:Y=""  D
 ..S Z=$O(^PSB(53.79,"AUID",PSBDFN,X,Y,""))
 ..I $P(^PSB(53.79,Z,0),U,9)="I"!($P(^PSB(53.79,Z,0),U,9)="S") S PSBCOMP=1,PSBPORA(PSBONX,X)=Y_U_$P(^PSB(53.79,Z,0),U,9),PSBINFDT=$P(^PSB(53.79,Z,0),U,6),PSBINFST=$P(^PSB(53.79,Z,0),U,9)
 Q
 ;
GETWSID(DFN,ORDN) ; generate a uniqe ID for wardstock
 ;
 S PSBNUM=0
 S X="" F  S X=$O(^PSB(53.79,"AUID",DFN,X)) Q:X=""  D
 .S Y="" F  S Y=$O(^PSB(53.79,"AUID",DFN,X,Y)) Q:Y=""  I Y["WS",$P(Y,"S",2)>PSBNUM S PSBNUM=$P(Y,"S",2)
 S PSBUID=DFN_"WS"_(PSBNUM+1)
 Q PSBUID
 ;
FNDLBLO(PIN,ORDN,PSBBGID) ;  Return order IV bag was printed for AND setup ^TMP("PSJ1",$J).
 ;
 S PSBPIN=PIN,(PSBORD,PSBORDX)=ORDN,FNDLBLO="" K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPIN,PSBORD,1)
 K PSBXDONE S PSBXDONE(PSBORDX)="" F  Q:(PSBORDX="")  Q:$D(PSBXDONE(PSBORDX))  D
 .S PSBXDONE(PSBORDX)="" K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPIN,PSBORDX,1)
 .I $D(^TMP("PSJ1",$J,1000,PSBBGID)) S FNDLBLO=$P(^TMP("PSJ1",$J,0),U,3) S PSBORDX="" Q
 .E  S FNDLBLO="" S PSBORDX=$P(^TMP("PSJ1",$J,0),U,4)
 Q $S($G(FNDLBLO)]"":FNDLBLO,$G(FNDLBLO)="":PSBORD)