source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLABELC.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1LRLABELC ;SLC/RAF - INTERMEC 4100 1X3 LABEL PRINT BARCODE/PLAIN ;10/20/93 10:16
2 ;;5.2;LAB SERVICE;**161**;Sep 27, 1994
3 ;This routine is used in conjunction with the Intermec program routine
4 ;LRBARC to print a 1X3 accession label.
5 ;
6EN ;
7 N CR,ETX,J,LF,LRFMT,LRTXT,STX,X
8 S LRRB=$G(LRRB)
9 S LRTXT=$$LRTXT^LRLABLD(.LRTS,35)
10 S LRFMT=7+$G(LRBAR(+$G(LRAA)),0)
11 I LRFMT=7 D PRT
12 I LRFMT=8 D BAR
13 I LRFMT>8 D BAR1
14 Q
15 ;
16PRT ; Plain label..no barcode
17 D INIT^LRLABELA(LRFMT)
18 W STX,$E(PNM,1,30)," ",$P(SSN,"-",3),CR,ETX
19 W STX,$E(LRINFW,1,20)," ORD:",$G(LRCE),CR,ETX
20 W STX,LRTXT,CR,ETX
21 W STX,LRACC
22 I $P(LRURGA,"^",2),$L(LRURGA,"^") W " <",$P(LRURGA,"^"),"> "
23 W " LOC:",LRLLOC,CR,ETX
24 W STX,LRTOP," ",LRPREF,CR,ETX
25 D TERM^LRLABELA
26 Q
27 ;
28BAR ; Barcode label (old style)
29 D INIT^LRLABELA(LRFMT)
30 W STX,$E(PNM,1,30)," ",$P(SSN,"-",3),CR,ETX
31 W STX,$E(LRINFW,1,20)," ORD:",$G(LRCE),CR,ETX
32 W STX,LRTXT,CR,ETX
33 W STX,LRACC
34 I $P(LRURGA,"^",2),$L(LRURGA,"^") W " <",$P(LRURGA,"^"),"> "
35 W " LOC:",LRLLOC,CR,ETX
36 W STX,$E(LRACC,1,2),CR,ETX
37 W STX,LRBARID,CR,ETX
38 D TERM^LRLABELA
39 Q
40 ;
41BAR1 ; Barcode label (multiple symbologies)
42 D INIT^LRLABELA(9)
43 W STX,PNM,CR,SSN,CR,ETX ; Patient name/SSN
44 W STX,"W:"_$E(LRLLOC,1,9),$S($L(LRRB):" B:"_LRRB,1:""),CR,ETX ; Location
45 W STX,LRBARID,CR,ETX ; Human-readable ID.
46 W STX,LRDAT,CR,LRACC,CR,ETX ; Date/Accession
47 W STX,"Order# ",LRCE,CR,LRTOP,CR,ETX ; Order #/Tube Top
48 W STX,LRTXT,CR,ETX ; Tests
49 D URGENCY^LRLABELA ; Accession urgency
50 W STX
51 F J=9:1:11 D
52 . I J'=LRFMT W LF,CR Q ; Skip symbology
53 . W LRBARID,CR ; Number to barcode.
54 W ETX
55 D TERM^LRLABELA
56 Q
Note: See TracBrowser for help on using the repository browser.