PSBOBL ;BIRMINGHAM/EFC-BAR CODE LABELS (ZEBRA SPECIFIC) ;8/18/21 18:50
;;3.0;BAR CODE MED ADMIN;**70,81,106,131**;Mar 2004;Build 11
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference/IA
; File 50/221
;
;*70 - 1459: Adding clinic to BL and BZ chui labels.
;*106- add Hazardous to Handle & Dispose alert text
;*131 - Restore y coordinate of first line of label to '25' so as to not be truncated
;
EN ;
N PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
N PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD,PSBCLIN ;[*70-1459]
N PSBDD,HAZ,PSBHAZ ;*106
S PSBIENS=PSBRPT_","
S PSBBAR=$P($P($G(^PSB(53.69,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=$$GET1^DIQ(53.69,PSBIENS,.31)
S PSBQTY=+$$GET1^DIQ(53.69,PSBIENS,.35)
S:PSBQTY PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
S PSBDD=$$GET1^DIQ(53.69,PSBIENS,.31,"I"),HAZ=$$HAZ^PSSUTIL($P(PSBDD,"~",2)) ;*106
S PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
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))_")" ;add code for IHS, PSB*3*81
S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
S PSBCLIN=$$GET1^DIQ(53.69,PSBIENS,5) ;[*70-1459]
S PSBLOT=$$GET1^DIQ(53.69,PSBIENS,.32)
S PSBEXP=$$GET1^DIQ(53.69,PSBIENS,.33)
S PSBMFG=$$GET1^DIQ(53.69,PSBIENS,.34)
S PSBFCB=$$GET1^DIQ(53.69,PSBIENS,.36)_"/"_$$GET1^DIQ(53.69,PSBIENS,.37)
S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
F PSBCNT=1:1:+$P(PSBRPT(.3),U,8) D LABEL
Q
;
LABEL ; Print the Label
W "^XA"
W !,"^LH0,0^FS"
W $$DATA(20,25,"Drug:")
W $$DATA(100,25,PSBDRUG)
S PSBHAZ=$S($P(HAZ,U):"<<HAZ Handle>> ",1:"") S:$P(HAZ,U,2) PSBHAZ=PSBHAZ_"<<HAZ Dispose>>" ;*106
; *131 - Tweaking the spacing of the dosage label and description to accommodate <HAZ> text
;W:$G(PSBHAZ)]"" $$DATA(20,35,PSBHAZ) ;*106
;I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
S HASHAZ=$G(PSBHAZ)]""
I HASHAZ D
. W $$DATA(20,50,PSBHAZ)
. I PSBDOSE]"" W $$DATA(20,75,"Dosage:") W $$DATA(100,75,PSBDOSE)
; If no HAZ text, keep the 'pre-106' x,y coordinates
I 'HASHAZ D
. I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
I PSBNAME]"" W $$DATA(350,60,PSBNAME)
I PSBCLIN]"" W $$DATA(350,90,"Clinic:") W $$DATA(400,90,PSBCLIN) ;[*70-1459]
I PSBCLIN="",PSBWARD]"" W $$DATA(350,90,"Ward:") W $$DATA(400,90,PSBWARD) ;[*70-1459]
I PSBLOT]"" W $$DATA(350,120,"Lot#:") W $$DATA(400,120,PSBLOT)
I PSBEXP]"" W $$DATA(500,120,"Exp:") W $$DATA(550,120,PSBEXP)
I PSBMFG]"" W $$DATA(350,150,"Mfg:") W $$DATA(400,150,PSBMFG)
W $$DATA(350,180,"Filled/Checked By:") W $$DATA(520,180,PSBFCB)
;
; Code 39 - Adjust spacing to accommodate <HAZ> text if it exists
I PSBSYM="C39" D
. I HASHAZ W !,"^BY2,3.0^FO20,107^B3N,N,70,Y,N^FR^FD"_PSBBAR_"^FS"
. I 'HASHAZ W !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
;
; Code 128 - Adjust spacing to accommodate <HAZ> text if it exists
I PSBSYM="128" D
. I HASHAZ W !,"^BY2,3.0^FO20,107^BCN,70,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
. I 'HASHAZ W !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
;
; Code I 2 of 5 - Adjust spacing to accommodate <HAZ> text if it exists
I PSBSYM="I25" D
. I HASHAZ W !,"^BY2,3.0^FO20,107^B2N,70,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
. I 'HASHAZ W !,"^BY2,3.0^FO20,100^B2N,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
;
I PSBSYM="" W $$DATA(20,100,"PSB DEFAULT BARCODE FORMAT Undefined.")
;
; Close Label
W !,"^XZ",!
H 2
Q
;
DATA(X,Y,TEXT) ; Code to place the data on the label
W !,"^FO"_X_","_Y_"^A0N,30,20^CI13^FR^FD"_TEXT_"^FS"
Q ""
;
INPTR ;Input transform for DRUG field (#.31) in file 53.69.
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 '$G(^PSDRUG(+Y,""I""))!($G(^(""I""))>DT),$P($G(^PSDRUG(+Y,2)),U,3)[""I""!($P($G(^PSDRUG(+Y,2)),U,3)[""U"")"
.D:+X'>0 MIX^DIC1
.D:+X>0 ^DIC
.S:+Y>0 X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y K:+Y<1 X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOBL 4390 printed Dec 13, 2024@01:40:20 Page 2
PSBOBL ;BIRMINGHAM/EFC-BAR CODE LABELS (ZEBRA SPECIFIC) ;8/18/21 18:50
+1 ;;3.0;BAR CODE MED ADMIN;**70,81,106,131**;Mar 2004;Build 11
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; File 50/221
+6 ;
+7 ;*70 - 1459: Adding clinic to BL and BZ chui labels.
+8 ;*106- add Hazardous to Handle & Dispose alert text
+9 ;*131 - Restore y coordinate of first line of label to '25' so as to not be truncated
+10 ;
EN ;
+1 NEW PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
+2 ;[*70-1459]
NEW PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD,PSBCLIN
+3 ;*106
NEW PSBDD,HAZ,PSBHAZ
+4 SET PSBIENS=PSBRPT_","
+5 SET PSBBAR=$PIECE($PIECE($GET(^PSB(53.69,PSBRPT,.3)),U,1),"~",2)
+6 ;
+7 SET PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
+8 if PSBPRE]""
SET PSBBAR=PSBPRE_$SELECT(PSBPRE?1.N:"-",1:"")_PSBBAR
+9 ;
+10 SET PSBDRUG=$$GET1^DIQ(53.69,PSBIENS,.31)
+11 SET PSBQTY=+$$GET1^DIQ(53.69,PSBIENS,.35)
+12 if PSBQTY
SET PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
+13 ;*106
SET PSBDD=$$GET1^DIQ(53.69,PSBIENS,.31,"I")
SET HAZ=$$HAZ^PSSUTIL($PIECE(PSBDD,"~",2))
+14 SET PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
+15 SET PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
+16 ;add code for IHS, PSB*3*81
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))_")"
+17 SET PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
+18 ;[*70-1459]
SET PSBCLIN=$$GET1^DIQ(53.69,PSBIENS,5)
+19 SET PSBLOT=$$GET1^DIQ(53.69,PSBIENS,.32)
+20 SET PSBEXP=$$GET1^DIQ(53.69,PSBIENS,.33)
+21 SET PSBMFG=$$GET1^DIQ(53.69,PSBIENS,.34)
+22 SET PSBFCB=$$GET1^DIQ(53.69,PSBIENS,.36)_"/"_$$GET1^DIQ(53.69,PSBIENS,.37)
+23 SET PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
+24 FOR PSBCNT=1:1:+$PIECE(PSBRPT(.3),U,8)
DO LABEL
+25 QUIT
+26 ;
LABEL ; Print the Label
+1 WRITE "^XA"
+2 WRITE !,"^LH0,0^FS"
+3 WRITE $$DATA(20,25,"Drug:")
+4 WRITE $$DATA(100,25,PSBDRUG)
+5 ;*106
SET PSBHAZ=$SELECT($PIECE(HAZ,U):"<<HAZ Handle>> ",1:"")
if $PIECE(HAZ,U,2)
SET PSBHAZ=PSBHAZ_"<<HAZ Dispose>>"
+6 ; *131 - Tweaking the spacing of the dosage label and description to accommodate <HAZ> text
+7 ;W:$G(PSBHAZ)]"" $$DATA(20,35,PSBHAZ) ;*106
+8 ;I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
+9 SET HASHAZ=$GET(PSBHAZ)]""
+10 IF HASHAZ
Begin DoDot:1
+11 WRITE $$DATA(20,50,PSBHAZ)
+12 IF PSBDOSE]""
WRITE $$DATA(20,75,"Dosage:")
WRITE $$DATA(100,75,PSBDOSE)
End DoDot:1
+13 ; If no HAZ text, keep the 'pre-106' x,y coordinates
+14 IF 'HASHAZ
Begin DoDot:1
+15 IF PSBDOSE]""
WRITE $$DATA(20,60,"Dosage:")
WRITE $$DATA(100,60,PSBDOSE)
End DoDot:1
+16 IF PSBNAME]""
WRITE $$DATA(350,60,PSBNAME)
+17 ;[*70-1459]
IF PSBCLIN]""
WRITE $$DATA(350,90,"Clinic:")
WRITE $$DATA(400,90,PSBCLIN)
+18 ;[*70-1459]
IF PSBCLIN=""
IF PSBWARD]""
WRITE $$DATA(350,90,"Ward:")
WRITE $$DATA(400,90,PSBWARD)
+19 IF PSBLOT]""
WRITE $$DATA(350,120,"Lot#:")
WRITE $$DATA(400,120,PSBLOT)
+20 IF PSBEXP]""
WRITE $$DATA(500,120,"Exp:")
WRITE $$DATA(550,120,PSBEXP)
+21 IF PSBMFG]""
WRITE $$DATA(350,150,"Mfg:")
WRITE $$DATA(400,150,PSBMFG)
+22 WRITE $$DATA(350,180,"Filled/Checked By:")
WRITE $$DATA(520,180,PSBFCB)
+23 ;
+24 ; Code 39 - Adjust spacing to accommodate <HAZ> text if it exists
+25 IF PSBSYM="C39"
Begin DoDot:1
+26 IF HASHAZ
WRITE !,"^BY2,3.0^FO20,107^B3N,N,70,Y,N^FR^FD"_PSBBAR_"^FS"
+27 IF 'HASHAZ
WRITE !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
End DoDot:1
+28 ;
+29 ; Code 128 - Adjust spacing to accommodate <HAZ> text if it exists
+30 IF PSBSYM="128"
Begin DoDot:1
+31 IF HASHAZ
WRITE !,"^BY2,3.0^FO20,107^BCN,70,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
+32 IF 'HASHAZ
WRITE !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
End DoDot:1
+33 ;
+34 ; Code I 2 of 5 - Adjust spacing to accommodate <HAZ> text if it exists
+35 IF PSBSYM="I25"
Begin DoDot:1
+36 IF HASHAZ
WRITE !,"^BY2,3.0^FO20,107^B2N,70,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
+37 IF 'HASHAZ
WRITE !,"^BY2,3.0^FO20,100^B2N,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
End DoDot:1
+38 ;
+39 IF PSBSYM=""
WRITE $$DATA(20,100,"PSB DEFAULT BARCODE FORMAT Undefined.")
+40 ;
+41 ; Close Label
+42 WRITE !,"^XZ",!
+43 HANG 2
+44 QUIT
+45 ;
DATA(X,Y,TEXT) ; Code to place the data on the label
+1 WRITE !,"^FO"_X_","_Y_"^A0N,30,20^CI13^FR^FD"_TEXT_"^FS"
+2 QUIT ""
+3 ;
INPTR ;Input transform for DRUG field (#.31) in file 53.69.
+1 if $LENGTH(X)>40!($LENGTH(X)<1)
KILL X
IF $DATA(X)
Begin DoDot:1
+2 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+3 NEW DIC
SET DIC="^PSDRUG("
SET DIC(0)="EQNM"
SET D="B^C^VAPN^VAC^NDC^XATC"
+4 SET DIC("S")="I '$G(^PSDRUG(+Y,""I""))!($G(^(""I""))>DT),$P($G(^PSDRUG(+Y,2)),U,3)[""I""!($P($G(^PSDRUG(+Y,2)),U,3)[""U"")"
+5 if +X'>0
DO MIX^DIC1
+6 if +X>0
DO ^DIC
+7 if +Y>0
SET X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y
if +Y<1
KILL X
End DoDot:1
+8 QUIT
+9 ;
