- BLRBARE ; IHS/DIR/FJE - INTERMEC 4100 2 LABEL FORMAT 12:36 ; [ 10/12/1999 12:25 PM ]
- ;;5.2;LR;**1003,1007,1009**;OCT 10, 1999
- ;;MODIFIED FOR SSMARIE 10/12/99 fje
- ;This routine will program the Intermec 4100 for two label formats
- ;which can be used with BLRLABLE routine to print one normal label
- ;and one with the accesion # barcoded if the BARCODE LABEL field in
- ;file 68 (Accession area) is set to YES
- FMT ;E3;F3 erases form 3 and accesses form #
- ;Hx defines field 0 as human readable code where x is variable # sent
- ;o150,390 sets origin from center of label for the variable #
- ;fx rotate value, 0=donot rotate,f1=90deg
- ;c2 field 0 will print in font 2
- ;;c0=7X9font,c1=7x11,c2=10x14,c7=5x7,c20=8,c21=12,c22=20
- ;h1=height of field is normal, h2=twice actual size
- ;w1=width of field is normal, w2=twice actual size
- ;d0,30 data entered is in printable mode and expect 30 char long
- ;b1 prints stat in reverse color
- ;Bx is barcode,o=origin,c0,1=Code3-9,h60=60dots high
- ;
- ;The code S X=0 X ^%ZOSF("RM") is used to replace U IO:0 which only
- ;works on an MSM system. This code will work with both DSM and MSM
- ;
- ZIS K %ZIS S %ZIS="QN" D ^%ZIS I POP W !?7,*7,"NO DEVICE SELECTED ",! D ^%ZISC Q
- S ZTIO=ION,ZTDTH=$H,ZTDESC="BAR CODE FORMAT DOWN LOAD",ZTRTN="BAR^BLRBARE" D ^%ZTLOAD
- D ^%ZISC W !!?5,"Barcode Formating Program",$S($G(ZTSK):" Queued ",1:" NOT QUEUED"),!!
- D ^%ZISC K ZTSK Q
- BAR ;programs format F3 for label with the accession # barcoded
- S:$D(ZTQUEUED) ZTREQ="@"
- S X=0 X ^%ZOSF("RM") W *2,*27,"C",*3
- W *2,*27,"P",*3
- W *2,"E3;F3;",*3
- L1 W *2,"F3;H1;o150,390;f1;c2;h1;w1;d0,35;",*3 ;TEST
- L2 W *2,"F3;H2;o133,350;f1;c2;h1;w1;d0,14;",*3 ;TOP/SPECIMEN
- L3 W *2,"F3;H3;o116,350;f1;c2;h1;w1;d0,13;",*3 ;ORDER#
- L4 W *2,"F3;H4;o160,450;f2;c2;h2;w1;d0,14;",*3 ;ACCESSION
- L5 W *2,"F3;H5;o175,418;f2;c2;h1;w1;d0,17;",*3 ;DATE IHS/FJE 3/18/99
- L6 W *2,"F3;H6;o30,350;f1;c2;h1;w1;d0,7;",*3 ;HRCN
- L7 W *2,"F3;H7;o30,250;f1;c2;h1;w1;d0,12;",*3 ;LOCATION
- L8 W *2,"F3;H8;o0,350;f1;c2;h2;w1;d0,21;",*3 ;PT.NAME
- L9 W *2,"F3;H9;o116,90;f1;c0;h1;w1;d0,4;",*3 ;STAT remove b1 (w3;b1:d0)
- L10 W *2,"F3;B10;o50,350;f1;c0,1;h60;w2;d0,5;",*3 ;BAR CODE
- L11 W *2,"F3;H11;o133,200;f1;c2;h1;w1;d0,16;",*3 ;PROVIDER
- L12 W *2,"F3;H12;o116,225;f1;c2;h1;w1;d0,14;",*3 ;DOB
- ;
- PLAIN ;programs format F2 for plain label /no barcoded accession #
- W *2,*27,"C",*3
- W *2,*27,"P",*3
- W *2,"E2;F2;",*3
- L13 W *2,"F2;H13;o150,450;f1;c2;h1;w1;d0,35;",*3 ;TEST
- L14 W *2,"F2;H14;o133,450;f1;c2;h1;w1;d0,13;",*3 ;ORDER#
- L15 W *2,"F2;H15;o133,250;f1;c2;h1;w1;d0,12",*3 ;LOCATION
- L16 W *2,"F2;H16;o105,350;f1;c2;h1;w1;d0,7;",*3 ;HRCN
- L17 W *2,"F2;H17;o105,250;f1;c2;h1;w1;d0,14;",*3 ;DOB
- L18 W *2,"F2;H18;o75,350;f1;c2;h2;w1;d0,21;",*3 ;PT.NAME
- L19 W *2,"F2;H19;o50,450;f1;c2;h1;w1;d0,14;",*3 ;TOP/SPECIMEN
- L20 W *2,"F2;H20;o33,450;f1;c2;h1;w1;d0,17;",*3 ;DATE IHS/FJE 10/12/99
- L21 W *2,"F2;H21;o0,450;f1;c2;h2;w1;d0,21;",*3 ;ACCESSION
- L22 W *2,"F2;H22;o33,155;f1;c0;h1;w1;d0,4;",*3 ;STAT remove b1 (w3;b1;d0)
- L23 W *2,"F2;H23;o50,300;f1;c2;h1;w1;d0,16;",*3 ;PROVIDER
- ;
- PRT ;programs the Intermec for print mode
- W *2,"R",*3
- D ^%ZISC Q
- TEST ;sets variables used with the test labels
- S NUMBER="00087",LRAN="CH 1008 87",LRDAT="10/08/93 18:00" D
- .S LRTOP="MARBLED RED",PNM="YOKUM,HOKUM",HRCN="1234567"
- .S DOB="10/30/1955"
- .S LRLLOC="SICU",LRCE="203987",LRTEST="CHEM 7",LRURG="STAT"
- .S LRACCAP="SURG 1008 999",LRSPEC="WOUND TISSUE"
- .S LRDOC="DR. SMITH"
- F3 ;prints sample of label with accession # barcoded
- S X=0 X ^%ZOSF("RM") W *2,*27,"E3",*24,!,LRTEST,!,LRTOP,!,"O#:",LRCE,!,LRAN,*3
- W *2,!,LRDAT,!,HRCN,!,"W:",LRLLOC,*3
- W *2,!,PNM,*3
- W *2,!,LRURG W *3
- W *2,!,NUMBER,*3
- W *2,!,LRDOC,*3
- W *2,!,DOB,*3
- W *2,*23,*15,"S30",*3
- ;
- F2 ;prints sample of label without a barcoded accession number
- S X=0 X ^%ZOSF("RM") W *2,*27,"E2",*24,!,LRTEST,!,"O#:",LRCE,!,"W:",LRLLOC,!,HRCN,!,"DOB:",DOB,*3
- W *2,!,PNM,!,LRTOP,*3
- W *2,!,LRDAT,!,LRAN,*3
- W *2,!,LRURG W *3
- W *2,!,LRDOC,*3
- W *2,*23,*15,"S30",*3
- Q
- BLRBARE ; IHS/DIR/FJE - INTERMEC 4100 2 LABEL FORMAT 12:36 ; [ 10/12/1999 12:25 PM ]
- +1 ;;5.2;LR;**1003,1007,1009**;OCT 10, 1999
- +2 ;;MODIFIED FOR SSMARIE 10/12/99 fje
- +3 ;This routine will program the Intermec 4100 for two label formats
- +4 ;which can be used with BLRLABLE routine to print one normal label
- +5 ;and one with the accesion # barcoded if the BARCODE LABEL field in
- +6 ;file 68 (Accession area) is set to YES
- FMT ;E3;F3 erases form 3 and accesses form #
- +1 ;Hx defines field 0 as human readable code where x is variable # sent
- +2 ;o150,390 sets origin from center of label for the variable #
- +3 ;fx rotate value, 0=donot rotate,f1=90deg
- +4 ;c2 field 0 will print in font 2
- +5 ;;c0=7X9font,c1=7x11,c2=10x14,c7=5x7,c20=8,c21=12,c22=20
- +6 ;h1=height of field is normal, h2=twice actual size
- +7 ;w1=width of field is normal, w2=twice actual size
- +8 ;d0,30 data entered is in printable mode and expect 30 char long
- +9 ;b1 prints stat in reverse color
- +10 ;Bx is barcode,o=origin,c0,1=Code3-9,h60=60dots high
- +11 ;
- +12 ;The code S X=0 X ^%ZOSF("RM") is used to replace U IO:0 which only
- +13 ;works on an MSM system. This code will work with both DSM and MSM
- +14 ;
- ZIS KILL %ZIS
- SET %ZIS="QN"
- DO ^%ZIS
- IF POP
- WRITE !?7,*7,"NO DEVICE SELECTED ",!
- DO ^%ZISC
- QUIT
- +1 SET ZTIO=ION
- SET ZTDTH=$HOROLOG
- SET ZTDESC="BAR CODE FORMAT DOWN LOAD"
- SET ZTRTN="BAR^BLRBARE"
- DO ^%ZTLOAD
- +2 DO ^%ZISC
- WRITE !!?5,"Barcode Formating Program",$SELECT($GET(ZTSK):" Queued ",1:" NOT QUEUED"),!!
- +3 DO ^%ZISC
- KILL ZTSK
- QUIT
- BAR ;programs format F3 for label with the accession # barcoded
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 SET X=0
- XECUTE ^%ZOSF("RM")
- WRITE *2,*27,"C",*3
- +3 WRITE *2,*27,"P",*3
- +4 WRITE *2,"E3;F3;",*3
- L1 ;TEST
- WRITE *2,"F3;H1;o150,390;f1;c2;h1;w1;d0,35;",*3
- L2 ;TOP/SPECIMEN
- WRITE *2,"F3;H2;o133,350;f1;c2;h1;w1;d0,14;",*3
- L3 ;ORDER#
- WRITE *2,"F3;H3;o116,350;f1;c2;h1;w1;d0,13;",*3
- L4 ;ACCESSION
- WRITE *2,"F3;H4;o160,450;f2;c2;h2;w1;d0,14;",*3
- L5 ;DATE IHS/FJE 3/18/99
- WRITE *2,"F3;H5;o175,418;f2;c2;h1;w1;d0,17;",*3
- L6 ;HRCN
- WRITE *2,"F3;H6;o30,350;f1;c2;h1;w1;d0,7;",*3
- L7 ;LOCATION
- WRITE *2,"F3;H7;o30,250;f1;c2;h1;w1;d0,12;",*3
- L8 ;PT.NAME
- WRITE *2,"F3;H8;o0,350;f1;c2;h2;w1;d0,21;",*3
- L9 ;STAT remove b1 (w3;b1:d0)
- WRITE *2,"F3;H9;o116,90;f1;c0;h1;w1;d0,4;",*3
- L10 ;BAR CODE
- WRITE *2,"F3;B10;o50,350;f1;c0,1;h60;w2;d0,5;",*3
- L11 ;PROVIDER
- WRITE *2,"F3;H11;o133,200;f1;c2;h1;w1;d0,16;",*3
- L12 ;DOB
- WRITE *2,"F3;H12;o116,225;f1;c2;h1;w1;d0,14;",*3
- +1 ;
- PLAIN ;programs format F2 for plain label /no barcoded accession #
- +1 WRITE *2,*27,"C",*3
- +2 WRITE *2,*27,"P",*3
- +3 WRITE *2,"E2;F2;",*3
- L13 ;TEST
- WRITE *2,"F2;H13;o150,450;f1;c2;h1;w1;d0,35;",*3
- L14 ;ORDER#
- WRITE *2,"F2;H14;o133,450;f1;c2;h1;w1;d0,13;",*3
- L15 ;LOCATION
- WRITE *2,"F2;H15;o133,250;f1;c2;h1;w1;d0,12",*3
- L16 ;HRCN
- WRITE *2,"F2;H16;o105,350;f1;c2;h1;w1;d0,7;",*3
- L17 ;DOB
- WRITE *2,"F2;H17;o105,250;f1;c2;h1;w1;d0,14;",*3
- L18 ;PT.NAME
- WRITE *2,"F2;H18;o75,350;f1;c2;h2;w1;d0,21;",*3
- L19 ;TOP/SPECIMEN
- WRITE *2,"F2;H19;o50,450;f1;c2;h1;w1;d0,14;",*3
- L20 ;DATE IHS/FJE 10/12/99
- WRITE *2,"F2;H20;o33,450;f1;c2;h1;w1;d0,17;",*3
- L21 ;ACCESSION
- WRITE *2,"F2;H21;o0,450;f1;c2;h2;w1;d0,21;",*3
- L22 ;STAT remove b1 (w3;b1;d0)
- WRITE *2,"F2;H22;o33,155;f1;c0;h1;w1;d0,4;",*3
- L23 ;PROVIDER
- WRITE *2,"F2;H23;o50,300;f1;c2;h1;w1;d0,16;",*3
- +1 ;
- PRT ;programs the Intermec for print mode
- +1 WRITE *2,"R",*3
- +2 DO ^%ZISC
- QUIT
- TEST ;sets variables used with the test labels
- +1 SET NUMBER="00087"
- SET LRAN="CH 1008 87"
- SET LRDAT="10/08/93 18:00"
- Begin DoDot:1
- +2 SET LRTOP="MARBLED RED"
- SET PNM="YOKUM,HOKUM"
- SET HRCN="1234567"
- +3 SET DOB="10/30/1955"
- +4 SET LRLLOC="SICU"
- SET LRCE="203987"
- SET LRTEST="CHEM 7"
- SET LRURG="STAT"
- +5 SET LRACCAP="SURG 1008 999"
- SET LRSPEC="WOUND TISSUE"
- +6 SET LRDOC="DR. SMITH"
- End DoDot:1
- F3 ;prints sample of label with accession # barcoded
- +1 SET X=0
- XECUTE ^%ZOSF("RM")
- WRITE *2,*27,"E3",*24,!,LRTEST,!,LRTOP,!,"O#:",LRCE,!,LRAN,*3
- +2 WRITE *2,!,LRDAT,!,HRCN,!,"W:",LRLLOC,*3
- +3 WRITE *2,!,PNM,*3
- +4 WRITE *2,!,LRURG
- WRITE *3
- +5 WRITE *2,!,NUMBER,*3
- +6 WRITE *2,!,LRDOC,*3
- +7 WRITE *2,!,DOB,*3
- +8 WRITE *2,*23,*15,"S30",*3
- +9 ;
- F2 ;prints sample of label without a barcoded accession number
- +1 SET X=0
- XECUTE ^%ZOSF("RM")
- WRITE *2,*27,"E2",*24,!,LRTEST,!,"O#:",LRCE,!,"W:",LRLLOC,!,HRCN,!,"DOB:",DOB,*3
- +2 WRITE *2,!,PNM,!,LRTOP,*3
- +3 WRITE *2,!,LRDAT,!,LRAN,*3
- +4 WRITE *2,!,LRURG
- WRITE *3
- +5 WRITE *2,!,LRDOC,*3
- +6 WRITE *2,*23,*15,"S30",*3
- +7 QUIT