source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLABAR.m@ 1742

Last change on this file since 1742 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1LRLABAR ;SLC/FHS - LABEL BAR CODE DOWN LOAD FORMAT
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;Format F3 is for the bar code label
4 ;Format F2 is for the plain non bar coded label.
5 ;Designed on a 8646 thermal transfer printer
6 ;Charater set=USA,Batch=disable,self test=disable
7 ;Baud=9600,parity=even,label stock=regular,control mode=computer
8 ;Protocol Command=User interface,format Rotation=breech,right margin=diable
9 ;bar width=10 mil LABEL SIZE= 1X3 IN. Part No 049114
10 ;top dip sw=all 5 off :mid dip sw=1 on 2-7 off
11 ;bottom dip sw 1-2 off,3-4 on,5 off,6 on,7-8 off
12ZIS S %ZIS="QN" D ^%ZIS I POP W !?7,$C(7),"NO DEVICE SELECTED ",! G STOP
13 S ZTIO=ION,ZTDTH=$H,ZTDESC="BAR CODE FORMATE DOWN LOAD",ZTRTN="BAR^LRLABAR" D ^%ZTLOAD Q
14BAR ;FORMAT BAR CODE LABELS
15 D RESET
16L0 D ENQ U IO W *2,*27,"P",*3 S:$D(TEST) X="PROGRAM MODE" D:$D(TEST) SHOW D ENQ ;SET INTO PROGRAM MODE
17L1 U IO W *2,"E3;F3;H0;o2,415;f1;c2;d0,50;h1;w1;",*3 S:$D(TEST) X="L1" D:$D(TEST) SHOW D ENQ ;BLANK
18L2 U IO W *2,"F3;H1;o20,415;f1;c0;d0,50;h1;w1;",*3 S:$D(TEST) X="L2" D:$D(TEST) SHOW D ENQ ;TEST/LOCATION
19L3 U IO W *2,"F3;H2;o33,415;f1;c0;d0,50;h1;w1;",*3 S:$D(TEST) X="L3" D:$D(TEST) SHOW D ENQ ;SSN
20L4 U IO W *2,"F3;H3;o47,415;f1;c1;d0,50;h1;w1;",*3 S:$D(TEST) X="L4" D:$D(TEST) SHOW D ENQ ;PATIENTS NAME
21L5 U IO W *2,"F3;H4;o60,160;f2;c2;d0,50;h1;w2;",*3 S:$D(TEST) X="L5" D:$D(TEST) SHOW D ENQ ;ACCESSION NUMBER
22L6 U IO W *2,"F3;B5;o60,415;f1;c0,1;h20;w1;i0;d0,20;p@",*3 S:$D(TEST) X="L6" D:$D(TEST) SHOW D ENQ ; BARCODE
23 U IO(0) D PRT
24PLAIN ;REGULAR LABELS NO BAR CODE
25L01 D ENQ U IO W *2,*27,"P",*3 S:$D(TEST) X="FORMAT F2" D:$D(TEST) SHOW D ENQ ;SET INTO PROGRAM MODE
26L11 U IO W *2,"E2;F2;H0;o2,415;f1;c2;d0,50;h1;w1;",*3 S:$D(TEST) X="L11" D:$D(TEST) SHOW D ENQ ;BLANK
27L21 U IO W *2,"F2;H1;o20,415;f1;c0;d0,50;h1;w1;",*3 S:$D(TEST) X="L21" D:$D(TEST) SHOW D ENQ ;TEST/LOCATION
28L31 U IO W *2,"F2;H2;o33,415;f1;c0;d0,50;h1;w1;",*3 S:$D(TEST) X="L31" D:$D(TEST) SHOW D ENQ ;SSN
29L41 U IO W *2,"F2;H3;o47,415;f1;c1;d0,50;h1;w1;",*3 S:$D(TEST) X="L41" D:$D(TEST) SHOW D ENQ ;PATIENTS NAME
30L61 U IO W *2,"F2;H4;o65,415;f1;c1;d0,50;h1;w1;",*3 S:$D(TEST) X="L61" D:$D(TEST) SHOW D ENQ ;TUBE VOL ORDER #
31 D PRT
32TEST ;
33 S PNM="PATIENTS,NAME",SSN="123-34-1234",LRURG="ROUTINE",LRAN=50,LRINFW="SICK GUY",LRCE=1100,LRTXT="GLU,NA,CO2,CL,K",LRTOP="RED",LRACC="CH 0521 50",LRLLOC="SICU" D F3,F2
34 Q
35F3 D ENQ U IO W *2,*27,"E3",*24,PNM_" "_$P(SSN,"-",3),!,LRINFW,!,LRTXT,!,LRACC_" "_LRURG_" "_LRLLOC,!,"CH",!,$E("00000",$L(LRAN),5)_LRAN,*30,1,*23,*3 D ENQ
36 Q
37F2 D ENQ U IO W *2,*27,"E2",*24,PNM_" "_$P(SSN,"-",3),!,LRINFW,!,LRTXT,!,LRACC_" "_LRURG_" "_LRLLOC,!,"RED TOP ORD:# RM/BED ",*30,1,*23,*3
38LF D ENQ U IO W *2,*12,*3 Q
39 Q
40RESET D ENQ U IO W *2,*16,*16,*3,! H 5
41ENQ U IO W *5 F U IO R *X:1 D:$D(TEST) SHOW Q:X=-1!(X=7)!(X=18)!(X=80)!(X=31)!(X=25)!(X=68)
42RD F U IO R *X:1 D:$D(TEST) SHOW Q:X=-1
43 Q
44PRT D ENQ U IO W *2,"R",*3 D ENQ Q
45SHOW Q:IO(0)=IO U IO(0) W !,X
46STOP Q ;
Note: See TracBrowser for help on using the repository browser.