PSBOBZ ;BIRMINGHAM/TTH-BAR CODE LABELS (MAIN) ;26-Feb-2013 11:55;PLS
;;3.0;BAR CODE MED ADMIN;**2,1015**;Mar 2004;Build 62
;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; ^%ZIS(2/3435
; File 50/221
;
; Modified - IHS/MSC/PLS - 02/07/2013 - Line EN+24
EN ;
N PSBI,PSBIENS,PSBQTY,PSBDOSE,PSBDRUG,PSBNAME,PSBNODE3,PSBWARD,PSBLOT,PSBBAR,PSBTLE,SL
N PSBEXP,PSBFD,PSBMFG,PSBCB,PSBFB,PSBFCB,PSBCNT,PSBANS,PSBORD,PSBPRE,PSBX,PSBY,PSBSYM,TEXT
;
N PSBXX,PSBYY,PSBCODE
S PSBXX=0 F S PSBXX=$O(^%ZIS(2,IOST(0),55,PSBXX)) Q:'PSBXX S PSBYY=$G(^(PSBXX,0)) I PSBYY]"" S PSBX=$P(PSBYY,"^"),PSBY=^(1),PSBCODE(PSBX)=PSBY
;
;The PSBRPT variable and PSBRPT(.3) array are set in the PSBO routine. It is the internal
;entry number from the BCMA REPORT REQUEST file (#53.69). This entry is created
;when the user submits the completed ScreenMan form from the Label Print option.
;
;
S PSBIENS=PSBRPT_","
S PSBBAR=$P($P($G(PSBRPT(.3)),U,1),"~",2)
S PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
S:PSBPRE]"" PSBBAR=PSBPRE_$S(PSBPRE?1.N:"-",1:"")_PSBBAR
S PSBDRUG=$P($P($G(PSBRPT(.3)),U,1),"~",1)
S PSBQTY=+$P($G(PSBRPT(.3)),U,5)
S:PSBQTY PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
I PSBQTY=0 S PSBDRUG=PSBDRUG_" (Qty: )"
S PSBDOSE=$P($G(PSBRPT(.3)),U,9)
I PSBDOSE]"" S PSBDOSE="Dose:"_PSBDOSE
I PSBDOSE="" S PSBDOSE="Dose:"
S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
;IHS/MSC/PLS - 02/07/13
;I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"
I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$S(DUZ("AG")="I":$$HRN^AUPNPAT($P($G(^PSB(53.69,+PSBIENS,.1)),U,2),$P(^(0),U,4)),1:$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9))_")"
I PSBNAME="" S PSBNAME="Patient:"
S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
I PSBWARD]"" S PSBWARD="Ward: "_PSBWARD
I PSBWARD="" S PSBWARD="Ward: "
S PSBLOT=$P($G(PSBRPT(.3)),U,2)
I PSBLOT]"" S PSBLOT="Lot: "_PSBLOT
I PSBLOT="" S PSBLOT="Lot: "
S PSBFD=$P($G(PSBRPT(.3)),U,3)
S PSBEXP=$$FMTE^XLFDT(PSBFD,5)
I PSBEXP]"" S PSBEXP="Exp: "_PSBEXP
I PSBEXP="" S PSBEXP="Exp: "
S PSBMFG=$P($G(PSBRPT(.3)),U,4)
I PSBMFG]"" S PSBMFG="Mfg: "_PSBMFG
I PSBMFG="" S PSBMFG="Mfg: "
S PSBFB=$P($G(PSBRPT(.3)),U,6) I PSBFB="" S PSBFB="_____"
S PSBCB=$P($G(PSBRPT(.3)),U,7) I PSBCB="" S PSBCB="_____"
S PSBFCB=PSBFB_"/"_PSBCB
F PSBCNT=1:1:+$P(PSBRPT(.3),U,8) D LABEL
Q
;
LABEL ;Get Barcode Label Type
;Barcode Type
S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
;
INIT ;Initialize barcode printer
I $D(PSBCODE("FI")) X PSBCODE("FI")
I $D(PSBCODE("FI1")) X PSBCODE("FI1")
I $D(PSBCODE("FI2")) X PSBCODE("FI2")
;
;Additional format settings
I PSBSYM]"",$D(PSBCODE("SBF")) X PSBCODE("SBF")
I PSBSYM="",$D(PSBCODE("EBF")) X PSBCODE("EBF")
;
D START ;execute control codes to start label
D PRINT ;execute control codes to print label
;
;Print Barcode Strip
;If barcode type is defined.
I PSBSYM]"",$D(PSBCODE("SB")) S TEXT=PSBBAR X PSBCODE("SB")
;If barcode type is not define.
I PSBSYM="",$D(PSBCODE("SB")) S TEXT="*NO BARCODE TYPE*" X PSBCODE("SB")
;
END ; Close Label or End of Label
I $G(PSBCODE("EL"))]"" X PSBCODE("EL")
H 2
Q
;
START ;Start Label Print Process
I $G(PSBCODE("SL"))]"" X PSBCODE("SL")
Q
;
PRINT ;Print barcode label
;
I PSBDRUG]"" S PSBTLE="PSBDRUG",TEXT="Drug: "_PSBDRUG D PROCESS
I PSBDOSE]"" S PSBTLE="PSBDOSE",TEXT=PSBDOSE D PROCESS
I PSBNAME]"" S PSBTLE="PSBNAME",TEXT=PSBNAME D PROCESS
I PSBWARD]"" S PSBTLE="PSBWARD",TEXT=PSBWARD D PROCESS
I PSBLOT]"" S PSBTLE="PSBLOT",TEXT=PSBLOT D PROCESS
I PSBEXP]"" S PSBTLE="PSBEXP",TEXT=PSBEXP D PROCESS
I PSBMFG]"" S PSBTLE="PSBMFG",TEXT=PSBMFG D PROCESS
I PSBFCB]"" S PSBTLE="PSBFCB",TEXT="Filled/Checked By: "_PSBFCB D PROCESS
Q
;
PROCESS ;Process control code and field data.
I $D(PSBCODE("STF")) X PSBCODE("STF")
I $D(PSBCODE("ST")) X PSBCODE("ST")
Q
;
INPTR ;Input transform for DRUG field (#.31) in file 53.69.
N PSBIAD,PSBDEA,D,Y
K:$L(X)>40!($L(X)<1) X I $D(X) D
.S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
.N DIC S DIC="^PSDRUG(",DIC(0)="EQNM",D="B^C^VAPN^VAC^NDC^XATC"
.S DIC("S")="I (($P($G(^PSDRUG(+Y,2)),U,3)[""I"")!($P($G(^(2)),U,3)[""U"")),(('$G(^PSDRUG(+Y,""I"")))!(DT'>$G(^(""I""))))"
.D:+X'>0 MIX^DIC1
.D:+X>0 ^DIC
.S:+Y>0 X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y K:+Y<1 X
Q
PSBOBZ ;BIRMINGHAM/TTH-BAR CODE LABELS (MAIN) ;26-Feb-2013 11:55;PLS
+1 ;;3.0;BAR CODE MED ADMIN;**2,1015**;Mar 2004;Build 62
+2 ;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; ^%ZIS(2/3435
+6 ; File 50/221
+7 ;
+8 ; Modified - IHS/MSC/PLS - 02/07/2013 - Line EN+24
EN ;
+1 NEW PSBI,PSBIENS,PSBQTY,PSBDOSE,PSBDRUG,PSBNAME,PSBNODE3,PSBWARD,PSBLOT,PSBBAR,PSBTLE,SL
+2 NEW PSBEXP,PSBFD,PSBMFG,PSBCB,PSBFB,PSBFCB,PSBCNT,PSBANS,PSBORD,PSBPRE,PSBX,PSBY,PSBSYM,TEXT
+3 ;
+4 NEW PSBXX,PSBYY,PSBCODE
+5 SET PSBXX=0
FOR
SET PSBXX=$ORDER(^%ZIS(2,IOST(0),55,PSBXX))
IF 'PSBXX
QUIT
SET PSBYY=$GET(^(PSBXX,0))
IF PSBYY]""
SET PSBX=$PIECE(PSBYY,"^")
SET PSBY=^(1)
SET PSBCODE(PSBX)=PSBY
+6 ;
+7 ;The PSBRPT variable and PSBRPT(.3) array are set in the PSBO routine. It is the internal
+8 ;entry number from the BCMA REPORT REQUEST file (#53.69). This entry is created
+9 ;when the user submits the completed ScreenMan form from the Label Print option.
+10 ;
+11 ;
+12 SET PSBIENS=PSBRPT_","
+13 SET PSBBAR=$PIECE($PIECE($GET(PSBRPT(.3)),U,1),"~",2)
+14 SET PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
+15 IF PSBPRE]""
SET PSBBAR=PSBPRE_$SELECT(PSBPRE?1.N:"-",1:"")_PSBBAR
+16 SET PSBDRUG=$PIECE($PIECE($GET(PSBRPT(.3)),U,1),"~",1)
+17 SET PSBQTY=+$PIECE($GET(PSBRPT(.3)),U,5)
+18 IF PSBQTY
SET PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
+19 IF PSBQTY=0
SET PSBDRUG=PSBDRUG_" (Qty: )"
+20 SET PSBDOSE=$PIECE($GET(PSBRPT(.3)),U,9)
+21 IF PSBDOSE]""
SET PSBDOSE="Dose:"_PSBDOSE
+22 IF PSBDOSE=""
SET PSBDOSE="Dose:"
+23 SET PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
+24 ;IHS/MSC/PLS - 02/07/13
+25 ;I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"
+26 IF PSBNAME]""
SET PSBNAME=PSBNAME_" ("_$SELECT(DUZ("AG")="I":$$HRN^AUPNPAT($PIECE($GET(^PSB(53.69,+PSBIENS,.1)),U,2),$PIECE(^(0),U,4)),1:$EXTRACT($$GET1^DIQ(53.69,PSBIENS,.121),6,9))_")"
+27 IF PSBNAME=""
SET PSBNAME="Patient:"
+28 SET PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
+29 IF PSBWARD]""
SET PSBWARD="Ward: "_PSBWARD
+30 IF PSBWARD=""
SET PSBWARD="Ward: "
+31 SET PSBLOT=$PIECE($GET(PSBRPT(.3)),U,2)
+32 IF PSBLOT]""
SET PSBLOT="Lot: "_PSBLOT
+33 IF PSBLOT=""
SET PSBLOT="Lot: "
+34 SET PSBFD=$PIECE($GET(PSBRPT(.3)),U,3)
+35 SET PSBEXP=$$FMTE^XLFDT(PSBFD,5)
+36 IF PSBEXP]""
SET PSBEXP="Exp: "_PSBEXP
+37 IF PSBEXP=""
SET PSBEXP="Exp: "
+38 SET PSBMFG=$PIECE($GET(PSBRPT(.3)),U,4)
+39 IF PSBMFG]""
SET PSBMFG="Mfg: "_PSBMFG
+40 IF PSBMFG=""
SET PSBMFG="Mfg: "
+41 SET PSBFB=$PIECE($GET(PSBRPT(.3)),U,6)
IF PSBFB=""
SET PSBFB="_____"
+42 SET PSBCB=$PIECE($GET(PSBRPT(.3)),U,7)
IF PSBCB=""
SET PSBCB="_____"
+43 SET PSBFCB=PSBFB_"/"_PSBCB
+44 FOR PSBCNT=1:1:+$PIECE(PSBRPT(.3),U,8)
DO LABEL
+45 QUIT
+46 ;
LABEL ;Get Barcode Label Type
+1 ;Barcode Type
+2 SET PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
+3 ;
INIT ;Initialize barcode printer
+1 IF $DATA(PSBCODE("FI"))
XECUTE PSBCODE("FI")
+2 IF $DATA(PSBCODE("FI1"))
XECUTE PSBCODE("FI1")
+3 IF $DATA(PSBCODE("FI2"))
XECUTE PSBCODE("FI2")
+4 ;
+5 ;Additional format settings
+6 IF PSBSYM]""
IF $DATA(PSBCODE("SBF"))
XECUTE PSBCODE("SBF")
+7 IF PSBSYM=""
IF $DATA(PSBCODE("EBF"))
XECUTE PSBCODE("EBF")
+8 ;
+9 ;execute control codes to start label
DO START
+10 ;execute control codes to print label
DO PRINT
+11 ;
+12 ;Print Barcode Strip
+13 ;If barcode type is defined.
+14 IF PSBSYM]""
IF $DATA(PSBCODE("SB"))
SET TEXT=PSBBAR
XECUTE PSBCODE("SB")
+15 ;If barcode type is not define.
+16 IF PSBSYM=""
IF $DATA(PSBCODE("SB"))
SET TEXT="*NO BARCODE TYPE*"
XECUTE PSBCODE("SB")
+17 ;
END ; Close Label or End of Label
+1 IF $GET(PSBCODE("EL"))]""
XECUTE PSBCODE("EL")
+2 HANG 2
+3 QUIT
+4 ;
START ;Start Label Print Process
+1 IF $GET(PSBCODE("SL"))]""
XECUTE PSBCODE("SL")
+2 QUIT
+3 ;
PRINT ;Print barcode label
+1 ;
+2 IF PSBDRUG]""
SET PSBTLE="PSBDRUG"
SET TEXT="Drug: "_PSBDRUG
DO PROCESS
+3 IF PSBDOSE]""
SET PSBTLE="PSBDOSE"
SET TEXT=PSBDOSE
DO PROCESS
+4 IF PSBNAME]""
SET PSBTLE="PSBNAME"
SET TEXT=PSBNAME
DO PROCESS
+5 IF PSBWARD]""
SET PSBTLE="PSBWARD"
SET TEXT=PSBWARD
DO PROCESS
+6 IF PSBLOT]""
SET PSBTLE="PSBLOT"
SET TEXT=PSBLOT
DO PROCESS
+7 IF PSBEXP]""
SET PSBTLE="PSBEXP"
SET TEXT=PSBEXP
DO PROCESS
+8 IF PSBMFG]""
SET PSBTLE="PSBMFG"
SET TEXT=PSBMFG
DO PROCESS
+9 IF PSBFCB]""
SET PSBTLE="PSBFCB"
SET TEXT="Filled/Checked By: "_PSBFCB
DO PROCESS
+10 QUIT
+11 ;
PROCESS ;Process control code and field data.
+1 IF $DATA(PSBCODE("STF"))
XECUTE PSBCODE("STF")
+2 IF $DATA(PSBCODE("ST"))
XECUTE PSBCODE("ST")
+3 QUIT
+4 ;
INPTR ;Input transform for DRUG field (#.31) in file 53.69.
+1 NEW PSBIAD,PSBDEA,D,Y
+2 IF $LENGTH(X)>40!($LENGTH(X)<1)
KILL X
IF $DATA(X)
Begin DoDot:1
+3 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+4 NEW DIC
SET DIC="^PSDRUG("
SET DIC(0)="EQNM"
SET D="B^C^VAPN^VAC^NDC^XATC"
+5 SET DIC("S")="I (($P($G(^PSDRUG(+Y,2)),U,3)[""I"")!($P($G(^(2)),U,3)[""U"")),(('$G(^PSDRUG(+Y,""I"")))!(DT'>$G(^(""I""))))"
+6 IF +X'>0
DO MIX^DIC1
+7 IF +X>0
DO ^DIC
+8 IF +Y>0
SET X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y
IF +Y<1
KILL X
End DoDot:1
+9 QUIT
