BLRIPLZI ; IHS/OIT/MKK - INTERMEC IPL ACCESSION NUMBER Barcode 39 Lab Label Intialization ; 26 Sep 2011 6:47 AM
;;5.2;IHS LABORATORY;**1030,1031**;NOV 01, 1997
;
; For IPL capable printers only. NO BINARY CODE VERSION.
;
; NOTE: Allows Users to specify SHIFT variable by using the
; PROGINIT label.
;
; Cloned from BLRBARZ
; Accession Number Barcoded using BARCODE 39 ONLY.
;
FMT ;EP - E3;F3 erases format 3 (BARCODE) and accesses form #
; E2;F2 erases format 2 (PLAIN) and accesses form #
;
ZIS ; EP
K %ZIS
S %ZIS="QN"
D ^%ZIS I POP W !?7,*7,"NO DEVICE SELECTED ",! D ^%ZISC Q
;
S ZTIO=ION
S ZTDTH=$H
S ZTDESC="BAR CODE FORMAT DOWN LOAD"
S ZTRTN="BAR^BLRIPLZI"
D ^%ZTLOAD
D ^%ZISC W !!?5,"Barcode Formating Program",$S($G(ZTSK):" Queued ",1:" NOT QUEUED"),!!
D ^%ZISC
K ZTSK
Q
;
BAR ; EP
NEW SHIFT
;
S:$D(ZTQUEUED) ZTREQ="@"
; S X=0 X ^%ZOSF("RM")
;
S SHIFT=200
;
D BARCODEI(SHIFT) ; Initializes format F3: accession # barcoded
D PLAININI(SHIFT) ; Initializes format F2: no barcode
W "<STX>R<ETX>" ; "Exit" Program Mode
;
D ^%ZISC
Q
;
PROGINIT ; EP -- SHIFT Prompt.
NEW SHIFT
;
D ^XBFMK
S DIR(0)="NOA^-200:200"
S DIR("A")="SHIFT Parameter (-200 to +200) "
D ^DIR
S SHIFT=+$G(Y)
;
K %ZIS
S %ZIS="QN"
D ^%ZIS I POP W !?7,*7,"NO DEVICE SELECTED ",! D ^%ZISC Q
;
S ZTSAVE("SHIFT")=""
S ZTIO=ION
S ZTDTH=$H
S ZTDESC="SHIFT BAR CODE FORMAT DOWN LOAD"
S ZTRTN="PROGBAR^BLRIPLZI"
D ^%ZTLOAD
D ^%ZISC W !!?5,"SHIFT Barcode Formating Program",$S($G(ZTSK):" Queued ",1:" NOT QUEUED"),!!
D ^%ZISC
K ZTSK
Q
;
PROGBAR ; EP - SHIFT Initialization
S:$D(ZTQUEUED) ZTREQ="@"
; S X=0 X ^%ZOSF("RM")
;
D BARCODEI(SHIFT) ; Initializes format F3: accession # barcoded
D PLAININI(SHIFT) ; Initializes format F2: no barcode
W "<STX>R<ETX>" ; "Exit" Program Mode
;
D ^%ZISC
Q
;
BARCODEI(SHIFT) ; EP - Bar code format, By ROWs,
NEW SYMBOLGY
D PREPCODE(3)
;
W "<STX>F3;H1;o165,"_(575-SHIFT)_";f1;c2;h1;w1;d0,32<ETX>" ; Test(s) (01)
W "<STX>F3;H2;o148,"_(575-SHIFT)_";f1;c2;h1;w1;d0,18<ETX>" ; Provider (02)
W "<STX>F3;H3;o148,"_(325-SHIFT)_";f1;c2;h1;w1;d0,11<ETX>" ; Top/Specimen (03)
W "<STX>F3;H4;o130,"_(575-SHIFT)_";f1;c2;h1;w1;d0,14<ETX>" ; Accession String (04)
W "<STX>F3;H5;o130,"_(360-SHIFT)_";f1;c2;h1;w1;d0,16<ETX>" ; Date/Time (05)
; S SYMBOLGY=+$G(^BLRSITE(+$G(DUZ(2)),6)) ; Intermec Symbology
; S SYMBOLGY=17
; W "<STX>F3;B6;o67,"_(570-SHIFT)_";f1;c"_SYMBOLGY_";h60;w3;d0,10<ETX>" ; Acc # Barcode 39 (06)
W "<STX>F3;B6;o67,"_(570-SHIFT)_";f1;c0;h60;w3;d0,10<ETX>" ; Acc # Barcode 39 (06) ; IHS/MSC/MKK - LR*5.2*1031
W "<STX>F3;H7;o47,"_(575-SHIFT)_";f1;c2;h1;w1;d0,13<ETX>" ; Order # (07)
W "<STX>F3;H8;o47,"_(330-SHIFT)_";f1;c2;h1;w1;d0,12<ETX>" ; Location (08)
W "<STX>F3;H9;o30,"_(575-SHIFT)_";f1;c2;h1;w1;d0,7<ETX>" ; Health Record Number (09)
W "<STX>F3;H10;o30,"_(470-SHIFT)_";f1;c2;h1;w1;d0,15<ETX>" ; Date of Birth (10)
W "<STX>F3;H11;o30,"_(260-SHIFT)_";f1;c2;h1;w1;d0,4<ETX>" ; Urgency (11)
W "<STX>F3;H12;o0,"_(575-SHIFT)_";f1;c2;h2;w1;d0,25<ETX>" ; Patient Name (12)
W "<STX>F3;H13;o0,"_(265-SHIFT)_";f1;c2;h1;w1;d0,5<ETX>" ; Sex (13)
;
Q
;
PREPCODE(FORMAT) ;EP - Code Common to BAR & PLAIN labels initialization
S:$G(SHIFT)="" SHIFT=0
S:+$G(SHIFT)<(-200) SHIFT=-200
S:+$G(SHIFT)>200 SHIFT=200
;
W "<STX><ESC>C<ETX>"
W "<STX><ESC>P<ETX>"
W "<STX>E"_FORMAT_";F"_FORMAT_"<ETX>"
Q
;
PLAININI(SHIFT) ; EP -- PLAIN format - By ROWs,
D PREPCODE(2)
;
W "<STX>F2;H14;o165,"_(575-SHIFT)_";f1;c2;h1;w1;d0,32<ETX>" ; Test(s) (01)
W "<STX>F2;H15;o146,"_(575-SHIFT)_";f1;c2;h1;w1;d0,11;<ETX>" ; Top/Specimen (02)
W "<STX>F2;H16;o146,"_(330-SHIFT)_";f1;c2;h1;w1;d0,12<ETX>" ; Location (03)
W "<STX>F2;H17;o127,"_(575-SHIFT)_";f1;c2;h1;w1;d0,28<ETX>" ; Provider (04)
W "<STX>F2;H18;o108,"_(575-SHIFT)_";f1;c2;h1;w1;d0,16<ETX>" ; Date/Time (05)
W "<STX>F2;H19;o72,"_(575-SHIFT)_";f1;c2;h2;w1;d0,14<ETX>" ; Accession String (06)
W "<STX>F2;H20;o51,"_(575-SHIFT)_";f1;c2;h1;w1;d0,13;<ETX>" ; Order # (07)
W "<STX>F2;H21;o51,"_(350-SHIFT)_";f1;c2;h1;w1;d0,5<ETX>" ; Sex (08)
W "<STX>F2;H22;o35,"_(200-SHIFT)_";f0;c0;h3;w3;b2;d0,4<ETX>" ; Urgency (09)
W "<STX>F2;H23;o32,"_(575-SHIFT)_";f1;c2;h1;w1;d0,7;<ETX>" ; Health Record Number (10)
W "<STX>F2;H24;o32,"_(460-SHIFT)_";f1;c2;h1;w1;d0,15<ETX>" ; Date of Birth (11)
W "<STX>F2;H25;o0,"_(575-SHIFT)_";f1;c2;h2;w1;d0,32<ETX>" ; Patient Name (12)
Q
;
TEST ; EP - sets variables used with the test labels
NEW DOB,HRCN,LRACCAP,LRAN,LRAS,LRCE,LRDAT
NEW LRLLOC,LRPROV,LRRB,LRSPEC,LRTOP,LRTXT,LRURG,LRUID
NEW NUMBER,PNM,SEX
;
D ^%ZIS
I POP D Q
. W !!,"DEVICE ISSUE. ROUTINE STOPPING.",!
. D PRESSKEY(5)
;
U IO
D F3
D ^%ZISC
Q
;
PRESSKEY(TAB) ; EP - Generic "PRESS RETURN KEY TO CONTINUE"
S DIR(0)="EA"
S DIR("A")=$J("",+$G(TAB))_"Press RETURN Key to continue: "
D ^DIR
Q
;
F3 ; EP - Prints TEST label with Accession # barcoded
D BARCODET
;
;
F2 ; Prints TEST label WITHOUT a barcoded UID number
D PLAINTST
;
W "<STX><FF><ETX>" ; Form Feed
Q
;
BARCODET ; EP - BARCODE format Test print
D SETVARS
;
W "<STX><ESC>E3<CAN><ETX>" ; Format 3 -- Barcode
W "<STX><CR>",$G(LRTXT),"<ETX>" ; Test(s) (01)
W "<STX><CR>","Prov:"_$G(LRPROV),"<ETX>" ; Provider (02)
W "<STX><CR>",$G(LRTOP),"<ETX>" ; Top/Specimen (03)
W "<STX><CR>"_$G(LRAS),"<ETX>" ; ACCESSION String (04)
W "<STX><CR>",$G(LRDAT),"<ETX>" ; Date/Time (05)
W "<STX><CR>",$G(LRAN),"<ETX>" ; UID # -- Bar Coded (06)
W "<STX><CR>","Ord#:"_$G(LRCE),"<ETX>" ; Order Number (07)
W "<STX><CR>",$G(LRLLOC)," ",$G(LRRB),"<ETX>" ; Location (08)
W "<STX><CR>",$G(HRCN),"<ETX>" ; Health Record Number (09)
W "<STX><CR>","DoB:"_$G(DOB),"<ETX>" ; Date of Birth (10)
W "<STX><CR>",$G(LRURG),"<ETX>" ; Urgency (11)
W "<STX><CR>",$E($G(PNM),1,27),"<ETX>" ; Patient Name (12)
W "<STX><CR>","Sex:",$G(SEX),"<ETX>" ; Sex (13)
W "<STX><ETB><SI>S30<ETX>" ; End WITHOUT Form Feed
Q
;
PLAINTST ; EP - PLAIN label TeST print
D SETVARS
;
W "<STX><ESC>E2<CAN><ETX>" ; Format 2 -- Plain
W "<STX><CR>",$G(LRTXT),"<ETX>" ; Test(s) (01)
W "<STX><CR>",$G(LRTOP),"<ETX>" ; Top/Specimen (02)
W "<STX><CR>",$G(LRLLOC)," ",$G(LRRB),"<ETX>" ; Location (03)
W "<STX><CR>","Prov:"_$G(LRPROV),"<ETX>" ; Provider (04)
W "<STX><CR>",$G(LRDAT),"<ETX>" ; Date/Time (05)
W "<STX><CR>",$G(LRAS),"<ETX>" ; ACCESSION String (06)
W "<STX><CR>","Ord#:",$G(LRCE),"<ETX>" ; Order Number (07)
W "<STX><CR>","Sex:",$G(SEX),"<ETX>" ; Sex (08)
W "<STX><CR>",$G(LRURG),"<ETX>" ; Urgency (09)
W "<STX><CR>",$G(HRCN),"<ETX>" ; Health Record Number (10)
W "<STX><CR>","DoB:"_$G(DOB),"<ETX>" ; Date of Birth (11)
W "<STX><CR>",$E($G(PNM),1,32),"<ETX>" ; Patient Name (12)
W "<STX><ETB><SI>S30<ETX>" ; End WITHOUT Form Feed
Q
;
SETVARS ; EP - Initialize variables for testing
D MAKERNDM
; 123456789012345678901234567890123
S LRTXT="CHEM 7,GLUCOSE,A1C,LIPID,CK,CRP,Chem7"
S LRTOP="MARBLED RED"
S LRDAT=$TR($$HTE^XLFDT($H,"2MZ"),"@"," ") ; Now Date/Time
S LRLLOC="TTLAB"
S LRURG="ROUTINE"
;
S SEX="M"
S LRPROV="DOCTOR,DOCTOR DOCTOR"
;
S LRACCAP="SURG 1008 999"
S LRSPEC="WOUND TISSUE"
S LRRB="B:22"
;
Q
;
MAKERNDM ; EP - Randomly set certain variables
NEW DAY,LDM,FNAME,LNAME,MON,NUM
;
S LRCE=$TR($J($R(1000000),6)," ","0")
S HRCN=$TR($J($R(10000000),7)," ","0")
S LRUID=$TR($J($R(10000000000),10)," ","0")
;
S LRAS=$$ACCRNDOM()
S NUM=+$P(LRAS," ",3)
S (LRAN,NUMBER)=$TR($J(NUM,5)," ","0")
;
S DOB=$$DOBSTR()
;
; S (PNM,PPNM)="DO NOT USE,TEST LABEL 12345678901234567890"
S FNAME=$$RANDNAME(10)
S LNAME=$$RANDNAME(10)
S PNM=LNAME_","_FNAME_" "_$TR($J($R(10000000000000000),18)," ","0")
;
Q
;
DOBSTR() ; EP - Make DoB random
NEW DOBMO,DOBDY,DOBYR
;
S DOBMO=0 F Q:DOBMO>0&(DOBMO<13) S DOBMO=$R(100)
S DOBDY=0 F Q:DOBDY>0&(DOBDY<28) S DOBDY=$R(10)
S DOBYR=1000 F Q:DOBYR>1900&(DOBYR<2009) S DOBYR=$R(10000)
Q $TR($J(DOBMO,2)," ","0")_"/"_$TR($J(DOBDY,2)," ","0")_"/"_DOBYR
;
RANDNAME(LEN) ; EP - Make Random (Gibberish) Name
NEW NAME,WOTALFA
;
S NAME=$J($R($RE($TR($J(1,LEN)," ","0")))," ","0")
S WOTALFA=$R(10)#2
S:WOTALFA NAME=$TR(NAME,"1234567890","ABCDEFGHIJ")
S:'WOTALFA NAME=$TR(NAME,"1234567890","KLMNOPQRST")
Q NAME
;
ACCRNDOM() ; EP - Make Random Accession numbers. CH only.
S MON=0 F Q:MON>0&(MON<13) S MON=$R(100)
S:MON=1!(MON=3)!(MON=5)!(MON=7)!(MON=8)!(MON=10)!(MON=12) LDM=31
S:MON=2 LDM=28
S:MON=4!(MON=6)!(MON=9)!(MON=11) LDM=31
S MON=$TR($J(MON,2)," ","0")
S DAY=0 F Q:DAY>0&(DAY<LDM) S DAY=$R(100)
S DAY=$TR($J(DAY,2)," ","0")
S NUM=0 F Q:NUM>0&(NUM<99) S NUM=$R(100)
S NUM=$TR($J(NUM,2)," ","0")
Q "CH "_MON_DAY_" "_NUM
;
JUSTBAR ; EP - Tests BARCODE format only
NEW DOB,HRCN,LRACCAP,LRAN,LRAS,LRCE,LRDAT
NEW LRLLOC,LRPROV,LRRB,LRSPEC,LRTOP,LRTXT,LRURG,LRUID
NEW NUMBER,PNM,SEX
;
;
D ^%ZIS
I POP D Q
. W !!,"DEVICE ISSUE. ROUTINE STOPPING.",!!
. D PRESSKEY(5)
;
U IO
;
D BARCODET
;
W "<STX><FF><ETX>" ; Form Feed
D ^%ZISC
Q
;
JUSTPLN ; EP - Tests PLAIN format only
NEW DOB,HRCN,LRACCAP,LRAN,LRAS,LRCE,LRDAT
NEW LRLLOC,LRPROV,LRRB,LRSPEC,LRTOP,LRTXT,LRURG,LRUID
NEW NUMBER,PNM,SEX
;
D ^%ZIS
I POP D Q
. W !!,"DEVICE ISSUE. ROUTINE STOPPING.",!!
. D PRESSKEY(5)
;
U IO
;
D PLAINTST
;
W "<STX><FF><ETX>" ; Form Feed
D ^%ZISC
Q
BLRIPLZI ; IHS/OIT/MKK - INTERMEC IPL ACCESSION NUMBER Barcode 39 Lab Label Intialization ; 26 Sep 2011 6:47 AM
+1 ;;5.2;IHS LABORATORY;**1030,1031**;NOV 01, 1997
+2 ;
+3 ; For IPL capable printers only. NO BINARY CODE VERSION.
+4 ;
+5 ; NOTE: Allows Users to specify SHIFT variable by using the
+6 ; PROGINIT label.
+7 ;
+8 ; Cloned from BLRBARZ
+9 ; Accession Number Barcoded using BARCODE 39 ONLY.
+10 ;
FMT ;EP - E3;F3 erases format 3 (BARCODE) and accesses form #
+1 ; E2;F2 erases format 2 (PLAIN) and accesses form #
+2 ;
ZIS ; EP
+1 KILL %ZIS
+2 SET %ZIS="QN"
+3 DO ^%ZIS
IF POP
WRITE !?7,*7,"NO DEVICE SELECTED ",!
DO ^%ZISC
QUIT
+4 ;
+5 SET ZTIO=ION
+6 SET ZTDTH=$HOROLOG
+7 SET ZTDESC="BAR CODE FORMAT DOWN LOAD"
+8 SET ZTRTN="BAR^BLRIPLZI"
+9 DO ^%ZTLOAD
+10 DO ^%ZISC
WRITE !!?5,"Barcode Formating Program",$SELECT($GET(ZTSK):" Queued ",1:" NOT QUEUED"),!!
+11 DO ^%ZISC
+12 KILL ZTSK
+13 QUIT
+14 ;
BAR ; EP
+1 NEW SHIFT
+2 ;
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ; S X=0 X ^%ZOSF("RM")
+5 ;
+6 SET SHIFT=200
+7 ;
+8 ; Initializes format F3: accession # barcoded
DO BARCODEI(SHIFT)
+9 ; Initializes format F2: no barcode
DO PLAININI(SHIFT)
+10 ; "Exit" Program Mode
WRITE "<STX>R<ETX>"
+11 ;
+12 DO ^%ZISC
+13 QUIT
+14 ;
PROGINIT ; EP -- SHIFT Prompt.
+1 NEW SHIFT
+2 ;
+3 DO ^XBFMK
+4 SET DIR(0)="NOA^-200:200"
+5 SET DIR("A")="SHIFT Parameter (-200 to +200) "
+6 DO ^DIR
+7 SET SHIFT=+$GET(Y)
+8 ;
+9 KILL %ZIS
+10 SET %ZIS="QN"
+11 DO ^%ZIS
IF POP
WRITE !?7,*7,"NO DEVICE SELECTED ",!
DO ^%ZISC
QUIT
+12 ;
+13 SET ZTSAVE("SHIFT")=""
+14 SET ZTIO=ION
+15 SET ZTDTH=$HOROLOG
+16 SET ZTDESC="SHIFT BAR CODE FORMAT DOWN LOAD"
+17 SET ZTRTN="PROGBAR^BLRIPLZI"
+18 DO ^%ZTLOAD
+19 DO ^%ZISC
WRITE !!?5,"SHIFT Barcode Formating Program",$SELECT($GET(ZTSK):" Queued ",1:" NOT QUEUED"),!!
+20 DO ^%ZISC
+21 KILL ZTSK
+22 QUIT
+23 ;
PROGBAR ; EP - SHIFT Initialization
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 ; S X=0 X ^%ZOSF("RM")
+3 ;
+4 ; Initializes format F3: accession # barcoded
DO BARCODEI(SHIFT)
+5 ; Initializes format F2: no barcode
DO PLAININI(SHIFT)
+6 ; "Exit" Program Mode
WRITE "<STX>R<ETX>"
+7 ;
+8 DO ^%ZISC
+9 QUIT
+10 ;
BARCODEI(SHIFT) ; EP - Bar code format, By ROWs,
+1 NEW SYMBOLGY
+2 DO PREPCODE(3)
+3 ;
+4 ; Test(s) (01)
WRITE "<STX>F3;H1;o165,"_(575-SHIFT)_";f1;c2;h1;w1;d0,32<ETX>"
+5 ; Provider (02)
WRITE "<STX>F3;H2;o148,"_(575-SHIFT)_";f1;c2;h1;w1;d0,18<ETX>"
+6 ; Top/Specimen (03)
WRITE "<STX>F3;H3;o148,"_(325-SHIFT)_";f1;c2;h1;w1;d0,11<ETX>"
+7 ; Accession String (04)
WRITE "<STX>F3;H4;o130,"_(575-SHIFT)_";f1;c2;h1;w1;d0,14<ETX>"
+8 ; Date/Time (05)
WRITE "<STX>F3;H5;o130,"_(360-SHIFT)_";f1;c2;h1;w1;d0,16<ETX>"
+9 ; S SYMBOLGY=+$G(^BLRSITE(+$G(DUZ(2)),6)) ; Intermec Symbology
+10 ; S SYMBOLGY=17
+11 ; W "<STX>F3;B6;o67,"_(570-SHIFT)_";f1;c"_SYMBOLGY_";h60;w3;d0,10<ETX>" ; Acc # Barcode 39 (06)
+12 ; Acc # Barcode 39 (06) ; IHS/MSC/MKK - LR*5.2*1031
WRITE "<STX>F3;B6;o67,"_(570-SHIFT)_";f1;c0;h60;w3;d0,10<ETX>"
+13 ; Order # (07)
WRITE "<STX>F3;H7;o47,"_(575-SHIFT)_";f1;c2;h1;w1;d0,13<ETX>"
+14 ; Location (08)
WRITE "<STX>F3;H8;o47,"_(330-SHIFT)_";f1;c2;h1;w1;d0,12<ETX>"
+15 ; Health Record Number (09)
WRITE "<STX>F3;H9;o30,"_(575-SHIFT)_";f1;c2;h1;w1;d0,7<ETX>"
+16 ; Date of Birth (10)
WRITE "<STX>F3;H10;o30,"_(470-SHIFT)_";f1;c2;h1;w1;d0,15<ETX>"
+17 ; Urgency (11)
WRITE "<STX>F3;H11;o30,"_(260-SHIFT)_";f1;c2;h1;w1;d0,4<ETX>"
+18 ; Patient Name (12)
WRITE "<STX>F3;H12;o0,"_(575-SHIFT)_";f1;c2;h2;w1;d0,25<ETX>"
+19 ; Sex (13)
WRITE "<STX>F3;H13;o0,"_(265-SHIFT)_";f1;c2;h1;w1;d0,5<ETX>"
+20 ;
+21 QUIT
+22 ;
PREPCODE(FORMAT) ;EP - Code Common to BAR & PLAIN labels initialization
+1 IF $GET(SHIFT)=""
SET SHIFT=0
+2 IF +$GET(SHIFT)<(-200)
SET SHIFT=-200
+3 IF +$GET(SHIFT)>200
SET SHIFT=200
+4 ;
+5 WRITE "<STX><ESC>C<ETX>"
+6 WRITE "<STX><ESC>P<ETX>"
+7 WRITE "<STX>E"_FORMAT_";F"_FORMAT_"<ETX>"
+8 QUIT
+9 ;
PLAININI(SHIFT) ; EP -- PLAIN format - By ROWs,
+1 DO PREPCODE(2)
+2 ;
+3 ; Test(s) (01)
WRITE "<STX>F2;H14;o165,"_(575-SHIFT)_";f1;c2;h1;w1;d0,32<ETX>"
+4 ; Top/Specimen (02)
WRITE "<STX>F2;H15;o146,"_(575-SHIFT)_";f1;c2;h1;w1;d0,11;<ETX>"
+5 ; Location (03)
WRITE "<STX>F2;H16;o146,"_(330-SHIFT)_";f1;c2;h1;w1;d0,12<ETX>"
+6 ; Provider (04)
WRITE "<STX>F2;H17;o127,"_(575-SHIFT)_";f1;c2;h1;w1;d0,28<ETX>"
+7 ; Date/Time (05)
WRITE "<STX>F2;H18;o108,"_(575-SHIFT)_";f1;c2;h1;w1;d0,16<ETX>"
+8 ; Accession String (06)
WRITE "<STX>F2;H19;o72,"_(575-SHIFT)_";f1;c2;h2;w1;d0,14<ETX>"
+9 ; Order # (07)
WRITE "<STX>F2;H20;o51,"_(575-SHIFT)_";f1;c2;h1;w1;d0,13;<ETX>"
+10 ; Sex (08)
WRITE "<STX>F2;H21;o51,"_(350-SHIFT)_";f1;c2;h1;w1;d0,5<ETX>"
+11 ; Urgency (09)
WRITE "<STX>F2;H22;o35,"_(200-SHIFT)_";f0;c0;h3;w3;b2;d0,4<ETX>"
+12 ; Health Record Number (10)
WRITE "<STX>F2;H23;o32,"_(575-SHIFT)_";f1;c2;h1;w1;d0,7;<ETX>"
+13 ; Date of Birth (11)
WRITE "<STX>F2;H24;o32,"_(460-SHIFT)_";f1;c2;h1;w1;d0,15<ETX>"
+14 ; Patient Name (12)
WRITE "<STX>F2;H25;o0,"_(575-SHIFT)_";f1;c2;h2;w1;d0,32<ETX>"
+15 QUIT
+16 ;
TEST ; EP - sets variables used with the test labels
+1 NEW DOB,HRCN,LRACCAP,LRAN,LRAS,LRCE,LRDAT
+2 NEW LRLLOC,LRPROV,LRRB,LRSPEC,LRTOP,LRTXT,LRURG,LRUID
+3 NEW NUMBER,PNM,SEX
+4 ;
+5 DO ^%ZIS
+6 IF POP
Begin DoDot:1
+7 WRITE !!,"DEVICE ISSUE. ROUTINE STOPPING.",!
+8 DO PRESSKEY(5)
End DoDot:1
QUIT
+9 ;
+10 USE IO
+11 DO F3
+12 DO ^%ZISC
+13 QUIT
+14 ;
PRESSKEY(TAB) ; EP - Generic "PRESS RETURN KEY TO CONTINUE"
+1 SET DIR(0)="EA"
+2 SET DIR("A")=$JUSTIFY("",+$GET(TAB))_"Press RETURN Key to continue: "
+3 DO ^DIR
+4 QUIT
+5 ;
F3 ; EP - Prints TEST label with Accession # barcoded
+1 DO BARCODET
+2 ;
+3 ;
F2 ; Prints TEST label WITHOUT a barcoded UID number
+1 DO PLAINTST
+2 ;
+3 ; Form Feed
WRITE "<STX><FF><ETX>"
+4 QUIT
+5 ;
BARCODET ; EP - BARCODE format Test print
+1 DO SETVARS
+2 ;
+3 ; Format 3 -- Barcode
WRITE "<STX><ESC>E3<CAN><ETX>"
+4 ; Test(s) (01)
WRITE "<STX><CR>",$GET(LRTXT),"<ETX>"
+5 ; Provider (02)
WRITE "<STX><CR>","Prov:"_$GET(LRPROV),"<ETX>"
+6 ; Top/Specimen (03)
WRITE "<STX><CR>",$GET(LRTOP),"<ETX>"
+7 ; ACCESSION String (04)
WRITE "<STX><CR>"_$GET(LRAS),"<ETX>"
+8 ; Date/Time (05)
WRITE "<STX><CR>",$GET(LRDAT),"<ETX>"
+9 ; UID # -- Bar Coded (06)
WRITE "<STX><CR>",$GET(LRAN),"<ETX>"
+10 ; Order Number (07)
WRITE "<STX><CR>","Ord#:"_$GET(LRCE),"<ETX>"
+11 ; Location (08)
WRITE "<STX><CR>",$GET(LRLLOC)," ",$GET(LRRB),"<ETX>"
+12 ; Health Record Number (09)
WRITE "<STX><CR>",$GET(HRCN),"<ETX>"
+13 ; Date of Birth (10)
WRITE "<STX><CR>","DoB:"_$GET(DOB),"<ETX>"
+14 ; Urgency (11)
WRITE "<STX><CR>",$GET(LRURG),"<ETX>"
+15 ; Patient Name (12)
WRITE "<STX><CR>",$EXTRACT($GET(PNM),1,27),"<ETX>"
+16 ; Sex (13)
WRITE "<STX><CR>","Sex:",$GET(SEX),"<ETX>"
+17 ; End WITHOUT Form Feed
WRITE "<STX><ETB><SI>S30<ETX>"
+18 QUIT
+19 ;
PLAINTST ; EP - PLAIN label TeST print
+1 DO SETVARS
+2 ;
+3 ; Format 2 -- Plain
WRITE "<STX><ESC>E2<CAN><ETX>"
+4 ; Test(s) (01)
WRITE "<STX><CR>",$GET(LRTXT),"<ETX>"
+5 ; Top/Specimen (02)
WRITE "<STX><CR>",$GET(LRTOP),"<ETX>"
+6 ; Location (03)
WRITE "<STX><CR>",$GET(LRLLOC)," ",$GET(LRRB),"<ETX>"
+7 ; Provider (04)
WRITE "<STX><CR>","Prov:"_$GET(LRPROV),"<ETX>"
+8 ; Date/Time (05)
WRITE "<STX><CR>",$GET(LRDAT),"<ETX>"
+9 ; ACCESSION String (06)
WRITE "<STX><CR>",$GET(LRAS),"<ETX>"
+10 ; Order Number (07)
WRITE "<STX><CR>","Ord#:",$GET(LRCE),"<ETX>"
+11 ; Sex (08)
WRITE "<STX><CR>","Sex:",$GET(SEX),"<ETX>"
+12 ; Urgency (09)
WRITE "<STX><CR>",$GET(LRURG),"<ETX>"
+13 ; Health Record Number (10)
WRITE "<STX><CR>",$GET(HRCN),"<ETX>"
+14 ; Date of Birth (11)
WRITE "<STX><CR>","DoB:"_$GET(DOB),"<ETX>"
+15 ; Patient Name (12)
WRITE "<STX><CR>",$EXTRACT($GET(PNM),1,32),"<ETX>"
+16 ; End WITHOUT Form Feed
WRITE "<STX><ETB><SI>S30<ETX>"
+17 QUIT
+18 ;
SETVARS ; EP - Initialize variables for testing
+1 DO MAKERNDM
+2 ; 123456789012345678901234567890123
+3 SET LRTXT="CHEM 7,GLUCOSE,A1C,LIPID,CK,CRP,Chem7"
+4 SET LRTOP="MARBLED RED"
+5 ; Now Date/Time
SET LRDAT=$TRANSLATE($$HTE^XLFDT($HOROLOG,"2MZ"),"@"," ")
+6 SET LRLLOC="TTLAB"
+7 SET LRURG="ROUTINE"
+8 ;
+9 SET SEX="M"
+10 SET LRPROV="DOCTOR,DOCTOR DOCTOR"
+11 ;
+12 SET LRACCAP="SURG 1008 999"
+13 SET LRSPEC="WOUND TISSUE"
+14 SET LRRB="B:22"
+15 ;
+16 QUIT
+17 ;
MAKERNDM ; EP - Randomly set certain variables
+1 NEW DAY,LDM,FNAME,LNAME,MON,NUM
+2 ;
+3 SET LRCE=$TRANSLATE($JUSTIFY($RANDOM(1000000),6)," ","0")
+4 SET HRCN=$TRANSLATE($JUSTIFY($RANDOM(10000000),7)," ","0")
+5 SET LRUID=$TRANSLATE($JUSTIFY($RANDOM(10000000000),10)," ","0")
+6 ;
+7 SET LRAS=$$ACCRNDOM()
+8 SET NUM=+$PIECE(LRAS," ",3)
+9 SET (LRAN,NUMBER)=$TRANSLATE($JUSTIFY(NUM,5)," ","0")
+10 ;
+11 SET DOB=$$DOBSTR()
+12 ;
+13 ; S (PNM,PPNM)="DO NOT USE,TEST LABEL 12345678901234567890"
+14 SET FNAME=$$RANDNAME(10)
+15 SET LNAME=$$RANDNAME(10)
+16 SET PNM=LNAME_","_FNAME_" "_$TRANSLATE($JUSTIFY($RANDOM(10000000000000000),18)," ","0")
+17 ;
+18 QUIT
+19 ;
DOBSTR() ; EP - Make DoB random
+1 NEW DOBMO,DOBDY,DOBYR
+2 ;
+3 SET DOBMO=0
FOR
IF DOBMO>0&(DOBMO<13)
QUIT
SET DOBMO=$RANDOM(100)
+4 SET DOBDY=0
FOR
IF DOBDY>0&(DOBDY<28)
QUIT
SET DOBDY=$RANDOM(10)
+5 SET DOBYR=1000
FOR
IF DOBYR>1900&(DOBYR<2009)
QUIT
SET DOBYR=$RANDOM(10000)
+6 QUIT $TRANSLATE($JUSTIFY(DOBMO,2)," ","0")_"/"_$TRANSLATE($JUSTIFY(DOBDY,2)," ","0")_"/"_DOBYR
+7 ;
RANDNAME(LEN) ; EP - Make Random (Gibberish) Name
+1 NEW NAME,WOTALFA
+2 ;
+3 SET NAME=$JUSTIFY($RANDOM($REVERSE($TRANSLATE($JUSTIFY(1,LEN)," ","0")))," ","0")
+4 SET WOTALFA=$RANDOM(10)#2
+5 IF WOTALFA
SET NAME=$TRANSLATE(NAME,"1234567890","ABCDEFGHIJ")
+6 IF 'WOTALFA
SET NAME=$TRANSLATE(NAME,"1234567890","KLMNOPQRST")
+7 QUIT NAME
+8 ;
ACCRNDOM() ; EP - Make Random Accession numbers. CH only.
+1 SET MON=0
FOR
IF MON>0&(MON<13)
QUIT
SET MON=$RANDOM(100)
+2 IF MON=1!(MON=3)!(MON=5)!(MON=7)!(MON=8)!(MON=10)!(MON=12)
SET LDM=31
+3 IF MON=2
SET LDM=28
+4 IF MON=4!(MON=6)!(MON=9)!(MON=11)
SET LDM=31
+5 SET MON=$TRANSLATE($JUSTIFY(MON,2)," ","0")
+6 SET DAY=0
FOR
IF DAY>0&(DAY<LDM)
QUIT
SET DAY=$RANDOM(100)
+7 SET DAY=$TRANSLATE($JUSTIFY(DAY,2)," ","0")
+8 SET NUM=0
FOR
IF NUM>0&(NUM<99)
QUIT
SET NUM=$RANDOM(100)
+9 SET NUM=$TRANSLATE($JUSTIFY(NUM,2)," ","0")
+10 QUIT "CH "_MON_DAY_" "_NUM
+11 ;
JUSTBAR ; EP - Tests BARCODE format only
+1 NEW DOB,HRCN,LRACCAP,LRAN,LRAS,LRCE,LRDAT
+2 NEW LRLLOC,LRPROV,LRRB,LRSPEC,LRTOP,LRTXT,LRURG,LRUID
+3 NEW NUMBER,PNM,SEX
+4 ;
+5 ;
+6 DO ^%ZIS
+7 IF POP
Begin DoDot:1
+8 WRITE !!,"DEVICE ISSUE. ROUTINE STOPPING.",!!
+9 DO PRESSKEY(5)
End DoDot:1
QUIT
+10 ;
+11 USE IO
+12 ;
+13 DO BARCODET
+14 ;
+15 ; Form Feed
WRITE "<STX><FF><ETX>"
+16 DO ^%ZISC
+17 QUIT
+18 ;
JUSTPLN ; EP - Tests PLAIN format only
+1 NEW DOB,HRCN,LRACCAP,LRAN,LRAS,LRCE,LRDAT
+2 NEW LRLLOC,LRPROV,LRRB,LRSPEC,LRTOP,LRTXT,LRURG,LRUID
+3 NEW NUMBER,PNM,SEX
+4 ;
+5 DO ^%ZIS
+6 IF POP
Begin DoDot:1
+7 WRITE !!,"DEVICE ISSUE. ROUTINE STOPPING.",!!
+8 DO PRESSKEY(5)
End DoDot:1
QUIT
+9 ;
+10 USE IO
+11 ;
+12 DO PLAINTST
+13 ;
+14 ; Form Feed
WRITE "<STX><FF><ETX>"
+15 DO ^%ZISC
+16 QUIT