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

BLRIPLZI.m

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