| 1 | PSBVDLU2 ;BIRMINGHAM/EFC-BCMA VDL UTILITIES ;Mar 2004
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;;Mar 2004
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference/IA
|
|---|
| 5 | ; EN^PSJBCMA1/2829
|
|---|
| 6 | ;
|
|---|
| 7 | INFUSING ; determine if there is any bag not completed on an order or its' previous orders
|
|---|
| 8 | N PSBSONX,PSBSPONX
|
|---|
| 9 | S PSBCOMP=0 K PSBPORA I '$D(PSBPONX) D PSJ1^PSBVT(DFN,PSBONX)
|
|---|
| 10 | S PSBPORA(PSBONX,PSBONX)="",PSBSONX=PSBONX,PSBSPONX=PSBPONX I PSBPONX'="",PSBPONX'["P" S PSBPORA(PSBSONX,PSBPONX)=""
|
|---|
| 11 | 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)=""
|
|---|
| 12 | .K ^TMP("PSJ1",$J) D EN^PSJBCMA1(DFN,PSBSPONX,1)
|
|---|
| 13 | S X="" F S X=$O(PSBPORA(PSBONX,X)) Q:X="" D
|
|---|
| 14 | .S Y="" F S Y=$O(^PSB(53.79,"AUID",PSBDFN,X,Y)) Q:Y="" D
|
|---|
| 15 | ..S Z=$O(^PSB(53.79,"AUID",PSBDFN,X,Y,""))
|
|---|
| 16 | ..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)
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | GETWSID(DFN,ORDN) ; generate a uniqe ID for wardstock
|
|---|
| 20 | ;
|
|---|
| 21 | S PSBNUM=0
|
|---|
| 22 | S X="" F S X=$O(^PSB(53.79,"AUID",DFN,X)) Q:X="" D
|
|---|
| 23 | .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)
|
|---|
| 24 | S PSBUID=DFN_"WS"_(PSBNUM+1)
|
|---|
| 25 | Q PSBUID
|
|---|
| 26 | ;
|
|---|
| 27 | FNDLBLO(PIN,ORDN,PSBBGID) ; Return order IV bag was printed for AND setup ^TMP("PSJ1",$J).
|
|---|
| 28 | ;
|
|---|
| 29 | S PSBPIN=PIN,(PSBORD,PSBORDX)=ORDN,FNDLBLO="" K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPIN,PSBORD,1)
|
|---|
| 30 | K PSBXDONE S PSBXDONE(PSBORDX)="" F Q:(PSBORDX="") Q:$D(PSBXDONE(PSBORDX)) D
|
|---|
| 31 | .S PSBXDONE(PSBORDX)="" K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPIN,PSBORDX,1)
|
|---|
| 32 | .I $D(^TMP("PSJ1",$J,1000,PSBBGID)) S FNDLBLO=$P(^TMP("PSJ1",$J,0),U,3) S PSBORDX="" Q
|
|---|
| 33 | .E S FNDLBLO="" S PSBORDX=$P(^TMP("PSJ1",$J,0),U,4)
|
|---|
| 34 | Q $S($G(FNDLBLO)]"":FNDLBLO,$G(FNDLBLO)="":PSBORD)
|
|---|
