source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLABELA.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1LRLABELA ;DALOI/JMC - INTERMEC 4100 1X2 LABEL PRINT BARCODE/PLAIN ;10/20/93 10:16
2 ;;5.2;LAB SERVICE;**161,218**;Sep 27, 1994
3 ;This routine is used in conjunction with the Intermec program routine
4 ;LRBARA to print a two label accession label for accession areas which
5 ;have their BAR CODE PRINT field set to YES
6 ;
7EN ;
8 N CR,ETX,J,LRFMT,LRTXT,STX,X
9 S LRRB=$G(LRRB)
10 ;
11 ; Set specific symbology.
12 S LRFMT=3+$G(LRBAR(+$G(LRAA)))
13 ;
14 S LRTXT=$$LRTXT^LRLABLD(.LRTS,$S(LRFMT=4:25,1:32))
15 ;
16 I LRFMT=3 D PRT
17 I LRFMT=4 D BAR
18 I LRFMT>4 D BAR1
19 ;
20 D TERM
21 Q
22 ;
23PRT ;plain label..no barcode
24 ;
25 D INIT(LRFMT)
26 ;
27 W STX,LRTXT,CR,ETX
28 W STX,"Order #",LRCE,CR,"W:"_$E(LRLLOC,1,9)_" B:"_LRRB,CR,ETX
29 W STX,SSN,CR,PNM,CR,LRTOP,CR,LRDAT,CR,LRACC,CR,ETX
30 ;
31 ; Determine if accession urgency printed normally or in reverse letters
32 I $P(LRURGA,"^",2),$L($P(LRURGA,"^")) W STX,$P(LRURGA,"^"),CR,ETX
33 E W STX,$C(10),CR,ETX
34 ;
35 Q
36 ;
37BAR ;barcode label..accession number barcoded (old style)
38 ;
39 D INIT(LRFMT)
40 ;
41 W STX,LRTXT,CR,ETX
42 W STX,LRTOP,CR,"Order #",LRCE,CR,LRACC,CR,LRDAT,CR,SSN,CR,ETX
43 W STX,$S($L(LRRB):"B:"_LRRB,1:"W:"_$E(LRLLOC,1,9)),CR,ETX
44 W STX,$E(PNM,1,27),CR,ETX
45 ;
46 ; Determine if accession urgency printed normally or in reverse letters
47 I $G(LRURG0)=1 W STX,"STAT",CR,ETX
48 E W STX,LF,CR,ETX
49 ;
50 W STX,LRBARID,CR,ETX
51 ;
52 Q
53 ;
54 ;
55BAR1 ; Barcode label (handles multiple barcode symbologies).
56 ;
57 D INIT(5)
58 ;
59 W STX,PNM,CR,SSN,CR,"W:"_LRLLOC,$S($L(LRRB):"/"_LRRB,1:""),CR,ETX
60 ;
61 ; Human-readable ID
62 W STX,LRBARID,CR,ETX
63 ;
64 ; Patient info
65 W STX,$S($G(LRINFW)="":LF,1:LRINFW),CR,ETX
66 ;
67 ; Order date/accession
68 W STX,LRDAT,CR,LRACC,CR,ETX
69 ;
70 ; Order #/specimen top
71 W STX,"Order #",LRCE,CR,LRTOP,CR,ETX
72 ;
73 ; Test list
74 W STX,LRTXT,CR,ETX
75 ;
76 D URGENCY
77 ;
78 ; Bar code specimen identifier
79 W STX
80 F J=5:1:7 D
81 . I J'=LRFMT W LF,CR Q ; Skip symbology.
82 . W LRBARID,CR
83 W ETX
84 ;
85 Q
86 ;
87INIT(LRFMT) ; Initialize label
88 ; Call with LRFMT = format to access on printer
89 ; Called above, LRLABELB, LRLABELC, LRBLJLA1
90 ;
91 S STX=$C(2),ETX=$C(3),LF=$C(10),CR=$C(13)
92 S X=0 X ^%ZOSF("RM")
93 ;
94 ; Put printer in advanced mode.
95 W STX,$C(27),"C",ETX
96 W STX,"R",ETX
97 W STX,$C(27),"E",LRFMT,$C(24),ETX
98 ;
99 Q
100 ;
101TERM ; Terminate and print label
102 ; Called above, LRLABELB, LRLABELC, LRBLJLA1
103 ;
104 W STX,$C(23,15),"S30",$C(12),ETX
105 ;
106 Q
107 ;
108URGENCY ; Print urgency based on settings.
109 ; Called above, LRLABELB, LRLABELC
110 ;
111 I $P(LRURGA,"^",2),$L($P(LRURGA,"^")) D Q
112 . ; Reverse field
113 . I $P(LRURGA,"^",2)=2 W STX,LF,CR,$P(LRURGA,"^"),CR,ETX Q
114 . ; Normal field
115 . W STX,$P(LRURGA,"^"),CR,LF,CR,ETX
116 ;
117 ; No urgency
118 W STX,LF,CR,LF,CR,ETX
119 ;
120 Q
Note: See TracBrowser for help on using the repository browser.