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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVDLU2 1846 printed Dec 13, 2024@01:41:22 Page 2
PSBVDLU2 ;BIRMINGHAM/EFC-BCMA VDL UTILITIES ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
+2 ;
+3 ; Reference/IA
+4 ; EN^PSJBCMA1/2829
+5 ;
INFUSING ; determine if there is any bag not completed on an order or its' previous orders
+1 NEW PSBSONX,PSBSPONX
+2 SET PSBCOMP=0
KILL PSBPORA
IF '$DATA(PSBPONX)
DO PSJ1^PSBVT(DFN,PSBONX)
+3 SET PSBPORA(PSBONX,PSBONX)=""
SET PSBSONX=PSBONX
SET PSBSPONX=PSBPONX
IF PSBPONX'=""
IF PSBPONX'["P"
SET PSBPORA(PSBSONX,PSBPONX)=""
+4 FOR
if (PSBPONX="")!(PSBSONX=PSBPONX)
QUIT
Begin DoDot:1
+5 KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(DFN,PSBSPONX,1)
End DoDot:1
if ^TMP("PSJ1",$JOB,0)=-1
QUIT
SET PSBPONX=$PIECE(^(0),"^",4)
if PSBPONX=""
QUIT
SET PSBSPONX=PSBPONX
if (PSBPONX]"")&(PSBPONX'["P")
SET PSBPORA(PSBSONX,PSBPONX)=""
+6 SET X=""
FOR
SET X=$ORDER(PSBPORA(PSBONX,X))
if X=""
QUIT
Begin DoDot:1
+7 SET Y=""
FOR
SET Y=$ORDER(^PSB(53.79,"AUID",PSBDFN,X,Y))
if Y=""
QUIT
Begin DoDot:2
+8 SET Z=$ORDER(^PSB(53.79,"AUID",PSBDFN,X,Y,""))
+9 IF $PIECE(^PSB(53.79,Z,0),U,9)="I"!($PIECE(^PSB(53.79,Z,0),U,9)="S")
SET PSBCOMP=1
SET PSBPORA(PSBONX,X)=Y_U_$PIECE(^PSB(53.79,Z,0),U,9)
SET PSBINFDT=$PIECE(^PSB(53.79,Z,0),U,6)
SET PSBINFST=$PIECE(^PSB(53.79,Z,0),U,9)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
GETWSID(DFN,ORDN) ; generate a uniqe ID for wardstock
+1 ;
+2 SET PSBNUM=0
+3 SET X=""
FOR
SET X=$ORDER(^PSB(53.79,"AUID",DFN,X))
if X=""
QUIT
Begin DoDot:1
+4 SET Y=""
FOR
SET Y=$ORDER(^PSB(53.79,"AUID",DFN,X,Y))
if Y=""
QUIT
IF Y["WS"
IF $PIECE(Y,"S",2)>PSBNUM
SET PSBNUM=$PIECE(Y,"S",2)
End DoDot:1
+5 SET PSBUID=DFN_"WS"_(PSBNUM+1)
+6 QUIT PSBUID
+7 ;
FNDLBLO(PIN,ORDN,PSBBGID) ; Return order IV bag was printed for AND setup ^TMP("PSJ1",$J).
+1 ;
+2 SET PSBPIN=PIN
SET (PSBORD,PSBORDX)=ORDN
SET FNDLBLO=""
KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(PSBPIN,PSBORD,1)
+3 KILL PSBXDONE
SET PSBXDONE(PSBORDX)=""
FOR
if (PSBORDX="")
QUIT
if $DATA(PSBXDONE(PSBORDX))
QUIT
Begin DoDot:1
+4 SET PSBXDONE(PSBORDX)=""
KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(PSBPIN,PSBORDX,1)
+5 IF $DATA(^TMP("PSJ1",$JOB,1000,PSBBGID))
SET FNDLBLO=$PIECE(^TMP("PSJ1",$JOB,0),U,3)
SET PSBORDX=""
QUIT
+6 IF '$TEST
SET FNDLBLO=""
SET PSBORDX=$PIECE(^TMP("PSJ1",$JOB,0),U,4)
End DoDot:1
+7 QUIT $SELECT($GET(FNDLBLO)]"":FNDLBLO,$GET(FNDLBLO)="":PSBORD)
