- 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 Jan 18, 2025@02:42:35 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)