Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRBARA

BLRBARA.m

Go to the documentation of this file. 
  1. BLRBARA ; IHS/DIR/FJE - INTERMEC 4100 2 LABEL FORMAT 12:36 ; [ 03/18/1999  6:44 AM ]
  1.  ;;5.2;LR;**1003,1007,1019**;MAR 25,2005
  1.  ;
  1.  ;This routine will program the Intermec 4100 for two label formats
  1.  ;which can be used with BLRLABLA routine to print one normal label
  1.  ;and one with the accesion # barcoded if the BARCODE LABEL field in
  1.  ;file 68 (Accession area) is set to YES
  1. FMT ;E3;F3 erases form 3 and accesses form #
  1.  ;Hx defines field 0 as human readable code where x is variable # sent
  1.  ;o150,390 sets origin from center of label for the variable #
  1.  ;fx rotate value, 0=donot rotate,f1=90deg
  1.  ;c2 field 0 will print in font 2
  1.  ;;c0=7X9font,c1=7x11,c2=10x14,c7=5x7,c20=8,c21=12,c22=20
  1.  ;h1=height of field is normal, h2=twice actual size
  1.  ;w1=width of field is normal, w2=twice actual size
  1.  ;d0,30 data entered is in printable mode and expect 30 char long
  1.  ;b1 prints stat in reverse color
  1.  ;Bx is barcode,o=origin,c0,1=Code3-9,h60=60dots high
  1.  ;
  1.  ;The code S X=0 X ^%ZOSF("RM") is used to replace U IO:0 which only
  1.  ;works on an MSM system. This code will work with both DSM and MSM
  1.  ;
  1. ZIS K %ZIS S %ZIS="QN" D ^%ZIS I POP W !?7,*7,"NO DEVICE SELECTED ",! D ^%ZISC Q
  1.  S ZTIO=ION,ZTDTH=$H,ZTDESC="BAR CODE FORMAT DOWN LOAD",ZTRTN="BAR^BLRBARA" D ^%ZTLOAD
  1.  D ^%ZISC W !!?5,"Barcode Formating Program",$S($G(ZTSK):" Queued ",1:" NOT QUEUED"),!!
  1.  ;
  1.  ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1019
  1.  ;      Modifying code to make more readable (making it easier
  1.  ;      to maintain) and to make sure default 3400E label will
  1.  ;      will print correctly.  Because of the number of extensive
  1.  ;      changes the original code is at the end.
  1.  ;
  1.  ; D ^%ZISC K ZTSK Q
  1.  D ^%ZISC
  1.  K ZTSK
  1.  Q
  1.  ;
  1. BAR ;programs format F3 for label with the accession # barcoded
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  S X=0 X ^%ZOSF("RM") W *2,*27,"C",*3
  1.  W *2,*27,"P",*3
  1.  W *2,"E3;F3;",*3
  1.  ;
  1.  W *2,"F3;H1;o155,295;f1;c2;h1;w1;d0,35;",*3       ; (01) TEST(S)
  1.  W *2,"F3;H2;o138,295;f1;c2;h1;w1;d0,14;",*3       ; (02) TOP/SPECIMEN
  1.  W *2,"F3;H3;o121,295;f1;c2;h1;w1;d0,13;",*3       ; (03) ORDER#
  1.  W *2,"F3;H4;o160,375;f2;c2;h2;w1;d0,14;",*3       ; (04) ACCESSION
  1.  W *2,"F3;H5;o175,335;f2;c2;h1;w1;d0,17;",*3       ; (05) DATE
  1.  W *2,"F3;H6;o35,295;f1;c2;h1;w1;d0,7;",*3         ; (06) HRCN
  1.  W *2,"F3;H7;o35,150;f1;c2;h1;w1;d0,20;",*3        ; (07) LOCATION
  1.  W *2,"F3;H8;o0,295;f1;c2;h2;w1;d0,21;",*3         ; (08) PT.NAME
  1.  W *2,"F3;H9;o125,100;f1;c0;h3;w3;b2;d0,4;",*3     ; (09) URGENCY
  1.  W *2,"F3;B10;o55,295;f1;c0,1;h60;w2;d0,5;",*3     ; (10) BAR CODE
  1.  ;
  1. PLAIN ;programs format F2 for plain label /no barcoded accession #
  1.  W *2,*27,"C",*3
  1.  W *2,*27,"P",*3
  1.  W *2,"E2;F2;",*3
  1.  ;
  1.  W *2,"F2;H14;o164,350;f1;c2;h1;w1;d0,35;",*3    ; (01) TEST(S)
  1.  W *2,"F2;H15;o147,350;f1;c2;h1;w1;d0,14;",*3    ; (02) TOP/SPECIMEN
  1.  W *2,"F2;H16;o53,350;f1;c2;h1;w1;d0,13;",*3     ; (03) ORDER#
  1.  W *2,"F2;H17;o75,350;f1;c2;h2;w1;d0,21;",*3     ; (04) ACCESSION STRING
  1.  W *2,"F2;H18;o108,350;f1;c2;h1;w1;d0,16;",*3    ; (05) DATE
  1.  W *2,"F2;H19;o33,350;f1;c2;h1;w1;d0,7;",*3      ; (06) HRCN
  1.  W *2,"F2;H20;o147,200;f1;c2;h1;w1;d0,12",*3     ; (07) LOCATION
  1.  W *2,"F2;H21;o0,350;f1;c2;h2;w1;d0,21;",*3      ; (08) PT.NAME
  1.  W *2,"F2;H22;o30,30;f0;c0;h3;w3;b2;d0,4;",*3    ; (09) URGENCY
  1.  ;
  1.  W *2,"F2;H23;o53,180;f1;c2;h1;w1;d0,5;",*3      ; (10) Sex
  1.  W *2,"F2;H24;o130,350;f1;c2;h1;w1;d0,50;",*3    ; (11) Provider
  1.  W *2,"F2;H25;o33,260;f1;c2;h1;w1;d0,16;",*3     ; (12) DOB
  1.  ;
  1. PRT ;programs the Intermec for print mode
  1.  W *2,"R",*3
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. TEST ;sets variables used with the test labels
  1.  S LRTXT="CHEM 7",LRTOP="MARBLED RED",LRCE="203987"
  1.  S LRACC="CH 1008 87",LRDAT="10/08/93 18:00",HRCN="1234567"
  1.  S LRLLOC="SICU",PNM="YOKUM,HOKUM",LRURG="STAT",LRAN=87
  1.  ;
  1. F3 ;prints sample of label with accession # barcoded
  1.  S X=0 X ^%ZOSF("RM")
  1.  W *2,*27,"E3",*24,!,LRTXT,*3               ; (01) Test(s)
  1.  W *2,!,LRTOP,*3                            ; (02) Collection sample - tube top/specimen
  1.  W *2,!,"Order#:",LRCE,*3                   ; (03) Order Number
  1.  W *2,!,LRACC,*3                            ; (04) Accession String
  1.  W *2,!,LRDAT,*3                            ; (05) Date
  1.  W *2,!,HRCN,*3                             ; (06) Health Record Number
  1.  W *2,!,LRLLOC,*3                           ; (07) Location
  1.  W *2,!,$E(PNM,1,27),*3                     ; (08) Patient Name
  1.  W *2,!,LRURG,*3                            ; (09) Urgency
  1.  W *2,!,$E("0000",$L(LRAN),4)_LRAN,*3       ; (10) Accession Number -- Bar Coded
  1.  W *2,*23,*15,"S30",*3
  1.  ;
  1. F2 ;prints sample of label without a barcoded accession number
  1.  ; set variables needed for plain label
  1.  S SEX="M",PROVN="TEST,DOCTOR",DOB="10/30/55"
  1.  ;
  1.  S X=0 X ^%ZOSF("RM")
  1.  W *2,"R",*3
  1.  W *2,*27,"E2",*24,!,LRTXT,*3               ; (01)
  1.  W *2,!,LRTOP,*3                            ; (02)
  1.  W *2,!,"Order#:",LRCE,*3                   ; (03)
  1.  W *2,!,LRACC,*3                            ; (04)
  1.  W *2,!,LRDAT,*3                            ; (05)
  1.  W *2,!,HRCN,*3                             ; (06)
  1.  W *2,!,LRLLOC,*3                           ; (07)
  1.  W *2,!,PNM,*3                              ; (08)
  1.  W *2,!,LRURG,*3                            ; (09)
  1.  W *2,!,"Sex:",SEX,*3                       ; (10) Sex
  1.  W *2,!,"Prov:"_$E(PROVN,1,18),*3           ; (11) Provider
  1.  W *2,!,DOB,*3                              ; (12) Date of Birth
  1.  W *2,*23,*15,"S30",*3
  1.  ;
  1.  ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1019
  1.  Q
  1.  ;
  1. ORIGCODE ;
  1.  ; BARCODE -- ORIGINAL
  1. L1 W *2,"F3;H1;o150,390;f1;c2;h1;w1;d0,35;",*3       ; TEST
  1. L2 W *2,"F3;H2;o133,350;f1;c2;h1;w1;d0,14;",*3       ; TOP/SPECIMEN
  1. L3 W *2,"F3;H3;o116,350;f1;c2;h1;w1;d0,13;",*3       ; ORDER#
  1. L4 W *2,"F3;H4;o160,450;f2;c2;h2;w1;d0,14;",*3       ; ACCESSION
  1. L5 W *2,"F3;H5;o175,418;f2;c2;h1;w1;d0,17;",*3       ; DATE
  1. L6 W *2,"F3;H6;o30,350;f1;c2;h1;w1;d0,7;",*3         ; HRCN
  1. L7 W *2,"F3;H7;o30,250;f1;c2;h1;w1;d0,20;",*3        ; LOCATION
  1. L8 W *2,"F3;H8;o0,350;f1;c2;h2;w1;d0,21;",*3         ; PT.NAME
  1. L9 W *2,"F3;H9;o115,160;f1;c0;h3;w3;b1;d0,4;",*3     ; STAT
  1. L10 W *2,"F3;B10;o50,350;f1;c0,1;h60;w2;d0,5;",*3     ; BAR CODE
  1.  ;
  1.  ; PLAIN -- ORIGINAL
  1.  W *2,"F2;H11;o150,450;f1;c2;h1;w1;d0,35;",*3      ; TEST
  1.  W *2,"F2;H12;o133,450;f1;c2;h1;w1;d0,13;",*3      ; ORDER#
  1.  W *2,"F2;H13;o133,250;f1;c2;h1;w1;d0,12",*3       ; LOCATION
  1.  W *2,"F2;H14;o105,350;f1;c2;h1;w1;d0,7;",*3       ; HRCN
  1.  W *2,"F2;H15;o105,250;f1;c2;h1;w1;d0,14;",*3      ; DOB
  1.  W *2,"F2;H16;o75,350;f1;c2;h2;w1;d0,21;",*3       ; PT.NAME
  1.  W *2,"F2;H17;o50,450;f1;c2;h1;w1;d0,14;",*3       ; TOP/SPECIMEN
  1.  W *2,"F2;H18;o33,450;f1;c2;h1;w1;d0,14;",*3       ; DATE
  1.  W *2,"F2;H19;o0,450;f1;c2;h2;w1;d0,21;",*3        ; ACCESSION
  1.  W *2,"F2;H20;o30,155;f1;c0;h3;w3;b1;d0,4;",*3     ; STAT
  1.  ;
  1.  ; TEST -- ORIGINAL
  1.  S NUMBER="00087",LRAN="CH 1008 87",LRDAT="10/08/93 18:00" D
  1.  .;S LRTOP="MARBLED RED",PNM="YOKUM,HOKUM",SSN="123-45-6789"
  1.  .S LRTOP="MARBLED RED",PNM="YOKUM,HOKUM",HRCN="1234567"  ;IHS/ANMC/CLS 11/1/95
  1.  .S DOB="10/30/55"  ;IHS/DIR TUC/AAB 04/15/98
  1.  .S LRLLOC="SICU",LRCE="203987",LRTXT="CHEM 7",LRURG="STAT"
  1.  .S LRACCAP="SURG 1008 999",LRSPEC="WOUND TISSUE"
  1.  ;
  1. OF3 ;prints sample of label with accession # barcoded
  1.  S X=0 X ^%ZOSF("RM") W *2,*27,"E3",*24,!,LRTXT,!,LRTOP,!,"Order#:",LRCE,!,LRAN,*3
  1.  ;W *2,!,LRDAT,!,SSN,!,"W:",LRLLOC,*3
  1.  W *2,!,LRDAT,!,HRCN,!,"W:",LRLLOC,*3  ;IHS/ANMC/CLS 11/1/95
  1.  W *2,!,PNM,*3
  1.  W *2,! W:$D(LRURG)&(LRURG="STAT") LRURG W *3
  1.  W *2,!,NUMBER,*3
  1.  W *2,*23,*15,"S30",*3
  1.  ;
  1. OF2 ;prints sample of label without a barcoded accession number
  1.  ;S X=0 X ^%ZOSF("RM") W *2,*27,"E2",*24,!,LRTXT,!,"Order#:",LRCE,!,"W:",LRLLOC,!,SSN,!,PNM,!,LRTOP,*3
  1.  ;S X=0 X ^%ZOSF("RM") W *2,*27,"E2",*24,!,LRTXT,!,"Order#:",LRCE,!,"W:",LRLLOC,!,HRCN,!,PNM,!,LRTOP,*3  ;IHS/ANMC/CLS 11/1/95
  1.  S X=0 X ^%ZOSF("RM") W *2,*27,"E2",*24,!,LRTXT,!,"Order#:",LRCE,!,"W:",LRLLOC,!,HRCN,!,"DOB:",DOB,*3  ;IHS/DIR TUC/AAB 04/15/98
  1.  W *2,!,PNM,!,LRTOP,*3  ;IHS/DIR TUC/AAB 04/15/98
  1.  W *2,!,LRDAT,!,LRAN,*3
  1.  W *2,! W:$D(LRURG)&(LRURG="STAT") LRURG W *3
  1.  W *2,*23,*15,"S30",*3
  1.  Q