LRLABELC.m

LRLABELC ;SLC/RAF - INTERMEC 4100 1X3 LABEL PRINT BARCODE/PLAIN ;10/20/93  10:16

 ;;5.2T9;LR;**1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**161**;Sep 27, 1994

 ;This routine is used in conjunction with the Intermec program routine

 ;LRBARC to print a 1X3 accession label.

 ;

EN ;

 N CR,ETX,J,LF,LRFMT,LRTXT,STX,X

 S LRRB=$G(LRRB)

 S LRTXT=$$LRTXT^LRLABLD(.LRTS,35)

 S LRFMT=7+$G(LRBAR(+$G(LRAA)),0)

 I LRFMT=7 D PRT

 I LRFMT=8 D BAR

 I LRFMT>8 D BAR1

 Q

 ;

PRT ; Plain label..no barcode

 D INIT^LRLABELA(LRFMT)

 W STX,$E(PNM,1,30),"  ",$P(SSN,"-",3),CR,ETX

 W STX,$E(LRINFW,1,20),"  ORD:",$G(LRCE),CR,ETX

 W STX,LRTXT,CR,ETX

 W STX,LRACC

 I $P(LRURGA,"^",2),$L(LRURGA,"^") W "  <",$P(LRURGA,"^"),">  "

 W " LOC:",LRLLOC,CR,ETX

 W STX,LRTOP,"  ",LRPREF,CR,ETX

 D TERM^LRLABELA

 Q

 ;

BAR ; Barcode label (old style)

 D INIT^LRLABELA(LRFMT)

 W STX,$E(PNM,1,30),"  ",$P(SSN,"-",3),CR,ETX

 W STX,$E(LRINFW,1,20),"  ORD:",$G(LRCE),CR,ETX

 W STX,LRTXT,CR,ETX

 W STX,LRACC

 I $P(LRURGA,"^",2),$L(LRURGA,"^") W "  <",$P(LRURGA,"^"),">  "

 W " LOC:",LRLLOC,CR,ETX

 W STX,$E(LRACC,1,2),CR,ETX

 W STX,LRBARID,CR,ETX

 D TERM^LRLABELA

 Q

 ;

BAR1 ; Barcode label (multiple symbologies)

 D INIT^LRLABELA(9)

 W STX,PNM,CR,SSN,CR,ETX ; Patient name/SSN

 W STX,"W:"_$E(LRLLOC,1,9),$S($L(LRRB):" B:"_LRRB,1:""),CR,ETX ; Location

 W STX,LRBARID,CR,ETX ; Human-readable ID.

 W STX,LRDAT,CR,LRACC,CR,ETX ; Date/Accession

 W STX,"Order# ",LRCE,CR,LRTOP,CR,ETX ; Order #/Tube Top

 W STX,LRTXT,CR,ETX ; Tests

 D URGENCY^LRLABELA ; Accession urgency

 W STX

 F J=9:1:11 D

 . I J'=LRFMT W LF,CR Q  ; Skip symbology

 . W LRBARID,CR ; Number to barcode.

 W ETX

 D TERM^LRLABELA

 Q

LRLABELC  ;SLC/RAF - INTERMEC 4100 1X3 LABEL PRINT BARCODE/PLAIN ;10/20/93  10:16

 +1       ;;5.2T9;LR;**1018**;Nov 17, 2004

 +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       ;

EN        ;

 +1        NEW CR,ETX,J,LF,LRFMT,LRTXT,STX,X

 +2        SET LRRB=$GET(LRRB)

 +3        SET LRTXT=$$LRTXT^LRLABLD(.LRTS,35)

 +4        SET LRFMT=7+$GET(LRBAR(+$GET(LRAA)),0)

 +5        IF LRFMT=7

               DO PRT

 +6        IF LRFMT=8

               DO BAR

 +7        IF LRFMT>8

               DO BAR1

 +8        QUIT 

 +9       ;

PRT       ; Plain label..no barcode

 +1        DO INIT^LRLABELA(LRFMT)

 +2        WRITE STX,$EXTRACT(PNM,1,30),"  ",$PIECE(SSN,"-",3),CR,ETX

 +3        WRITE STX,$EXTRACT(LRINFW,1,20),"  ORD:",$GET(LRCE),CR,ETX

 +4        WRITE STX,LRTXT,CR,ETX

 +5        WRITE STX,LRACC

 +6        IF $PIECE(LRURGA,"^",2)

               IF $LENGTH(LRURGA,"^")

                   WRITE "  <",$PIECE(LRURGA,"^"),">  "

 +7        WRITE " LOC:",LRLLOC,CR,ETX

 +8        WRITE STX,LRTOP,"  ",LRPREF,CR,ETX

 +9        DO TERM^LRLABELA

 +10       QUIT 

 +11      ;

BAR       ; Barcode label (old style)

 +1        DO INIT^LRLABELA(LRFMT)

 +2        WRITE STX,$EXTRACT(PNM,1,30),"  ",$PIECE(SSN,"-",3),CR,ETX

 +3        WRITE STX,$EXTRACT(LRINFW,1,20),"  ORD:",$GET(LRCE),CR,ETX

 +4        WRITE STX,LRTXT,CR,ETX

 +5        WRITE STX,LRACC

 +6        IF $PIECE(LRURGA,"^",2)

               IF $LENGTH(LRURGA,"^")

                   WRITE "  <",$PIECE(LRURGA,"^"),">  "

 +7        WRITE " LOC:",LRLLOC,CR,ETX

 +8        WRITE STX,$EXTRACT(LRACC,1,2),CR,ETX

 +9        WRITE STX,LRBARID,CR,ETX

 +10       DO TERM^LRLABELA

 +11       QUIT 

 +12      ;

BAR1      ; Barcode label (multiple symbologies)

 +1        DO INIT^LRLABELA(9)

 +2       ; Patient name/SSN

           WRITE STX,PNM,CR,SSN,CR,ETX

 +3       ; Location

           WRITE STX,"W:"_$EXTRACT(LRLLOC,1,9),$SELECT($LENGTH(LRRB):" B:"_LRRB,1:""),CR,ETX

 +4       ; Human-readable ID.

           WRITE STX,LRBARID,CR,ETX

 +5       ; Date/Accession

           WRITE STX,LRDAT,CR,LRACC,CR,ETX

 +6       ; Order #/Tube Top

           WRITE STX,"Order# ",LRCE,CR,LRTOP,CR,ETX

 +7       ; Tests

           WRITE STX,LRTXT,CR,ETX

 +8       ; Accession urgency

           DO URGENCY^LRLABELA

 +9        WRITE STX

 +10       FOR J=9:1:11

               Begin DoDot:1

 +11      ; Skip symbology

                   IF J'=LRFMT

                       WRITE LF,CR

                       QUIT 

 +12      ; Number to barcode.

                   WRITE LRBARID,CR

               End DoDot:1

 +13       WRITE ETX

 +14       DO TERM^LRLABELA

 +15       QUIT