PSBOBL ;BIRMINGHAM/EFC-BAR CODE LABELS (ZEBRA SPECIFIC) ;26-Feb-2013 11:57;PLS
;;3.0;BAR CODE MED ADMIN;**1015**;Mar 2004;Build 62
;
; Reference/IA
; File 50/221
;
; Modified - IHS/MSC/PLS - 02/26/13 - Line EN+14
EN ;
N PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
N PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD
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 PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
;IHS/MSC/PLS - 02/26/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))_")"
S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
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)
I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
I PSBNAME]"" W $$DATA(350,60,PSBNAME)
I PSBWARD]"" W $$DATA(350,90,"Ward:") W $$DATA(400,90,PSBWARD)
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
I PSBSYM="C39" W !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
;
; Code 128
I PSBSYM="128" W !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
;
; Code I 2 of 5
I PSBSYM="I25" 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
;
PSBOBL ;BIRMINGHAM/EFC-BAR CODE LABELS (ZEBRA SPECIFIC) ;26-Feb-2013 11:57;PLS
+1 ;;3.0;BAR CODE MED ADMIN;**1015**;Mar 2004;Build 62
+2 ;
+3 ; Reference/IA
+4 ; File 50/221
+5 ;
+6 ; Modified - IHS/MSC/PLS - 02/26/13 - Line EN+14
EN ;
+1 NEW PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
+2 NEW PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD
+3 SET PSBIENS=PSBRPT_","
+4 SET PSBBAR=$PIECE($PIECE($GET(^PSB(53.69,PSBRPT,.3)),U,1),"~",2)
+5 ;
+6 SET PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
+7 IF PSBPRE]""
SET PSBBAR=PSBPRE_$SELECT(PSBPRE?1.N:"-",1:"")_PSBBAR
+8 ;
+9 SET PSBDRUG=$$GET1^DIQ(53.69,PSBIENS,.31)
+10 SET PSBQTY=+$$GET1^DIQ(53.69,PSBIENS,.35)
+11 IF PSBQTY
SET PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
+12 SET PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
+13 SET PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
+14 ;IHS/MSC/PLS - 02/26/13
+15 ;I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"
+16 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 SET PSBLOT=$$GET1^DIQ(53.69,PSBIENS,.32)
+19 SET PSBEXP=$$GET1^DIQ(53.69,PSBIENS,.33)
+20 SET PSBMFG=$$GET1^DIQ(53.69,PSBIENS,.34)
+21 SET PSBFCB=$$GET1^DIQ(53.69,PSBIENS,.36)_"/"_$$GET1^DIQ(53.69,PSBIENS,.37)
+22 SET PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
+23 FOR PSBCNT=1:1:+$PIECE(PSBRPT(.3),U,8)
DO LABEL
+24 QUIT
+25 ;
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 IF PSBDOSE]""
WRITE $$DATA(20,60,"Dosage:")
WRITE $$DATA(100,60,PSBDOSE)
+6 IF PSBNAME]""
WRITE $$DATA(350,60,PSBNAME)
+7 IF PSBWARD]""
WRITE $$DATA(350,90,"Ward:")
WRITE $$DATA(400,90,PSBWARD)
+8 IF PSBLOT]""
WRITE $$DATA(350,120,"Lot#:")
WRITE $$DATA(400,120,PSBLOT)
+9 IF PSBEXP]""
WRITE $$DATA(500,120,"Exp:")
WRITE $$DATA(550,120,PSBEXP)
+10 IF PSBMFG]""
WRITE $$DATA(350,150,"Mfg:")
WRITE $$DATA(400,150,PSBMFG)
+11 WRITE $$DATA(350,180,"Filled/Checked By:")
WRITE $$DATA(520,180,PSBFCB)
+12 ;
+13 ; Code 39
+14 IF PSBSYM="C39"
WRITE !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
+15 ;
+16 ; Code 128
+17 IF PSBSYM="128"
WRITE !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
+18 ;
+19 ; Code I 2 of 5
+20 IF PSBSYM="I25"
WRITE !,"^BY2,3.0^FO20,100^B2N,80,Y,N,N^FR^FD"_PSBBAR_"^FS"
+21 ;
+22 IF PSBSYM=""
WRITE $$DATA(20,100,"PSB DEFAULT BARCODE FORMAT Undefined.")
+23 ;
+24 ; Close Label
+25 WRITE !,"^XZ",!
+26 HANG 2
+27 QUIT
+28 ;
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 ;
