PSB3P131 ;BIRMINGHAM/TTH-BUILD,KCF CONTROL CODES ;9/16/21 10:38
;;3.0;BAR CODE MED ADMIN;**131**;Mar 2004;Build 11
;;Per VA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; ^%ZIS(2/3435
; ^%ZIS(2/3884
;
INIT ; IMPORT BASE TM
N AB,ANS,CODE,NAME,PSBCHO,PSBCODE,PSBTYPE,X,Y,IOST,CODE
S X="P-TCP-ZEB-UD-HAZ 200DPI",DIC=3.2,DIC(0)="L" D ^DIC
Q:'+Y
S IOST(0)=+Y,CODE="W $C(27),""E"" D CLOSE^NVSPRTU"
S DA=IOST(0),DIE=DIC,DR=".02///0;2///#;1////32;3///26;7////^S X=CODE" D ^DIE
;
ZEBCC ;Zebra Barcode Printer Character Control Code auto install
; Use $SELECT function to set proper barcode printer control code variable "CODE"
;
I '$D(^%ZIS(2,IOST(0),55,"B","SL")) S AB="SL",NAME="Start Label",CODE="W !,""^XA"",!,""^LH0,0^FS""" D FILE
I '$D(^%ZIS(2,IOST(0),55,"B","EL")) S AB="EL",NAME="End Label",CODE="W !,""^XZ""" D FILE
I '$D(^%ZIS(2,IOST(0),55,"B","ST")) S AB="ST",NAME="Start Text",CODE="W !,""^FO""_PSBTYPE_""^A0N,30,20^CI13^FR^FD""_TEXT_""^FS""" D FILE
I '$D(^%ZIS(2,IOST(0),55,"B","SB")) S AB="SB",NAME="Start Barcode" D D FILE
.S CODE="S PSBTYPE=$S(PSBSYM=""I25"":""B2N"",PSBSYM=""128"":""BCN"",1:""B3N,N"")"
.S CODE=CODE_" S:PSBSYM="""" PSBBAR=""NO-CODE"" W !,""^BY2,3.0,80^FO20,115^""_PSBTYPE_"",60,Y,N^FR^FD""_PSBBAR_""^FS"""
I '$D(^%ZIS(2,IOST(0),55,"B","STF")) S AB="STF",NAME="Start Text Field" D D FILE
.S CODE="S PSBTYPE=$S(PSBTLE=""PSBDRUG"":""20,25"",PSBTLE=""PSBDOSE"":""20,85"",PSBTLE=""PSBNAME"":""350,60"",PSBTLE=""PSBWARD"":""350,90"",PSBTLE=""PSBLOT"":""350,120"","
.S CODE=CODE_"PSBTLE=""PSBEXP"":""350,150"",PSBTLE=""PSBMFG"":""500,150"",PSBTLE=""PSBFCB"":""350,180"",1:""0,0"")"
I '$D(^%ZIS(2,IOST(0),55,"B","HAZ")) S AB="HAZ",NAME="Hazardous Text Field",CODE="S PSBTYPE=$S(PSBTLE=""HAZTEXT"":""20,60"",1:""0,0"")" D FILE
D END
Q
;
FILE ;Set local array for Zebra Barcode Printer Default Settings
;
K DD,DIC,DIE,DO
S DIC(0)="L",DA(1)=IOST(0),X=AB,DIC="^%ZIS(2,"_DA(1)_",55," D FILE^DICN K DD,DO
S DIE=DIC,DA=+Y,DA(1)=IOST(0)
S DR=".01////"_AB_";1////"_NAME_";2////^S X=CODE" D ^DIE
Q
END ;Clean Up Routine Variables
K %ZIS,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,POP,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSB3P131 2246 printed Oct 16, 2024@17:40:40 Page 2
PSB3P131 ;BIRMINGHAM/TTH-BUILD,KCF CONTROL CODES ;9/16/21 10:38
+1 ;;3.0;BAR CODE MED ADMIN;**131**;Mar 2004;Build 11
+2 ;;Per VA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; ^%ZIS(2/3435
+6 ; ^%ZIS(2/3884
+7 ;
INIT ; IMPORT BASE TM
+1 NEW AB,ANS,CODE,NAME,PSBCHO,PSBCODE,PSBTYPE,X,Y,IOST,CODE
+2 SET X="P-TCP-ZEB-UD-HAZ 200DPI"
SET DIC=3.2
SET DIC(0)="L"
DO ^DIC
+3 if '+Y
QUIT
+4 SET IOST(0)=+Y
SET CODE="W $C(27),""E"" D CLOSE^NVSPRTU"
+5 SET DA=IOST(0)
SET DIE=DIC
SET DR=".02///0;2///#;1////32;3///26;7////^S X=CODE"
DO ^DIE
+6 ;
ZEBCC ;Zebra Barcode Printer Character Control Code auto install
+1 ; Use $SELECT function to set proper barcode printer control code variable "CODE"
+2 ;
+3 IF '$DATA(^%ZIS(2,IOST(0),55,"B","SL"))
SET AB="SL"
SET NAME="Start Label"
SET CODE="W !,""^XA"",!,""^LH0,0^FS"""
DO FILE
+4 IF '$DATA(^%ZIS(2,IOST(0),55,"B","EL"))
SET AB="EL"
SET NAME="End Label"
SET CODE="W !,""^XZ"""
DO FILE
+5 IF '$DATA(^%ZIS(2,IOST(0),55,"B","ST"))
SET AB="ST"
SET NAME="Start Text"
SET CODE="W !,""^FO""_PSBTYPE_""^A0N,30,20^CI13^FR^FD""_TEXT_""^FS"""
DO FILE
+6 IF '$DATA(^%ZIS(2,IOST(0),55,"B","SB"))
SET AB="SB"
SET NAME="Start Barcode"
Begin DoDot:1
+7 SET CODE="S PSBTYPE=$S(PSBSYM=""I25"":""B2N"",PSBSYM=""128"":""BCN"",1:""B3N,N"")"
+8 SET CODE=CODE_" S:PSBSYM="""" PSBBAR=""NO-CODE"" W !,""^BY2,3.0,80^FO20,115^""_PSBTYPE_"",60,Y,N^FR^FD""_PSBBAR_""^FS"""
End DoDot:1
DO FILE
+9 IF '$DATA(^%ZIS(2,IOST(0),55,"B","STF"))
SET AB="STF"
SET NAME="Start Text Field"
Begin DoDot:1
+10 SET CODE="S PSBTYPE=$S(PSBTLE=""PSBDRUG"":""20,25"",PSBTLE=""PSBDOSE"":""20,85"",PSBTLE=""PSBNAME"":""350,60"",PSBTLE=""PSBWARD"":""350,90"",PSBTLE=""PSBLOT"":""350,120"","
+11 SET CODE=CODE_"PSBTLE=""PSBEXP"":""350,150"",PSBTLE=""PSBMFG"":""500,150"",PSBTLE=""PSBFCB"":""350,180"",1:""0,0"")"
End DoDot:1
DO FILE
+12 IF '$DATA(^%ZIS(2,IOST(0),55,"B","HAZ"))
SET AB="HAZ"
SET NAME="Hazardous Text Field"
SET CODE="S PSBTYPE=$S(PSBTLE=""HAZTEXT"":""20,60"",1:""0,0"")"
DO FILE
+13 DO END
+14 QUIT
+15 ;
FILE ;Set local array for Zebra Barcode Printer Default Settings
+1 ;
+2 KILL DD,DIC,DIE,DO
+3 SET DIC(0)="L"
SET DA(1)=IOST(0)
SET X=AB
SET DIC="^%ZIS(2,"_DA(1)_",55,"
DO FILE^DICN
KILL DD,DO
+4 SET DIE=DIC
SET DA=+Y
SET DA(1)=IOST(0)
+5 SET DR=".01////"_AB_";1////"_NAME_";2////^S X=CODE"
DO ^DIE
+6 QUIT
END ;Clean Up Routine Variables
+1 KILL %ZIS,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,POP,X,Y
+2 QUIT
