LRLABELG.m

LRLABELG ;DALOI/JMC - 1x3 label for Zebra Stripe printer; 6/4/98

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

 ; Print Lab labels 25mm X 76mm (1X3) labels.

 ; Label length = 200 dots.

 ;

 N LRFONT,LRZ,ETX,STX

 ;

 D LH

 W STX

 ;

 ; Print urgency

 I $P(LRURGA,"^",2) D

 . I $P(LRURGA,"^",2)=2 D

 . . ; Set up graphic box.

 . . D GB^LRLABELD(340,0,15+($L($P(LRURGA,"^"))*12)_",20,20")

 . . ; Set field reverse.

 . . S LRFONT=LRFONT_"^FR"

 . D PL^LRLABELD(350,3,$P(LRURGA,"^"),LRFONT)

 . D FONT

 ;

 ; Print infection warning if present.

 I $L($G(LRINFW)) D

 . ; Make 'big' box else make 'little' box.

 . I $L(LRINFW)>10 S LRZ=130_",40,40"

 . E  S LRZ=10+($L(LRINFW)*12)_",25,25"

 . D GB^LRLABELD(442,0,LRZ)

 . S LRFONT=LRFONT_"^FR"

 . ; Print infection warning.

 . D PL^LRLABELD(447,3,$E(LRINFW,1,10),LRFONT)

 . ; Print remainder of infection warning.

 . I $L(LRINFW)>10 D PL^LRLABELD(447,21,$E(LRINFW,11,20),LRFONT)

 . D FONT

 ;

 ; Print patient name.

 S LRFONT="^ADN,36,10"

 D PL^LRLABELD(0,0,$E(PNM,1,25),LRFONT)

 D FONT

 ;

 ; Print patient identifier.

 S LRFONT="^ADN,36,10"

 D PL^LRLABELD(0,40,SSN,LRFONT)

 D FONT

 ;

 ; Print patient location.

 D PL^LRLABELD(200,40,"Ward: "_LRLLOC,LRFONT)

 ;

 ; Print room-bed number.

 I $L(LRRB) D PL^LRLABELD(200,60," Bed: "_LRRB,LRFONT)

 ;

 ; Print accession.

 D PL^LRLABELD(0,80,LRACC,LRFONT)

 ;

 ; Print order number.

 D PL^LRLABELD(188,80,"Order #"_LRCE,LRFONT)

 ;

 ; Print Identifier.

 D PL^LRLABELD(0,100,LRUID,LRFONT)

 ;

 ; Print accession date.

 D PL^LRLABELD(188,100,LRDAT,LRFONT)

 ;

 ; Print collection sample.

 I LRXL,N-I<LRXL S X=LRTOP

 E  S X=LRPREF_LRTOP

 D PL^LRLABELD(0,120,$E(X,1,55),LRFONT)

 ;

 ; Print list of tests

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

 D PL^LRLABELD(0,140,LRTXT,LRFONT)

 ;

 W ETX

 ;

 Q

 ;

 ;

LH ; Set Label Home ("LH") parameters.

 ;

 S STX=$C(2),ETX=$C(3)

 ;

 ; Set Print Orientation ("PO") to Inverted, and Label Home ("LH") parameters.

 W STX,"^POI^LH240,5",ETX

 ;

FONT ;

 ; Default font.

 S LRFONT="^ADN"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRLABELG   2065     printed  Mar 13, 2025@21:20:23                                                                                                                                                                                                    Page 2

LRLABELG  ;DALOI/JMC - 1x3 label for Zebra Stripe printer; 6/4/98

 +1       ;;5.2;LAB SERVICE;**218**;Sep 27, 1994

 +2       ; Print Lab labels 25mm X 76mm (1X3) labels.

 +3       ; Label length = 200 dots.

 +4       ;

 +5        NEW LRFONT,LRZ,ETX,STX

 +6       ;

 +7        DO LH

 +8        WRITE STX

 +9       ;

 +10      ; Print urgency

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

               Begin DoDot:1

 +12               IF $PIECE(LRURGA,"^",2)=2

                       Begin DoDot:2

 +13      ; Set up graphic box.

 +14                       DO GB^LRLABELD(340,0,15+($LENGTH($PIECE(LRURGA,"^"))*12)_",20,20")

 +15      ; Set field reverse.

 +16                       SET LRFONT=LRFONT_"^FR"

                       End DoDot:2

 +17               DO PL^LRLABELD(350,3,$PIECE(LRURGA,"^"),LRFONT)

 +18               DO FONT

               End DoDot:1

 +19      ;

 +20      ; Print infection warning if present.

 +21       IF $LENGTH($GET(LRINFW))

               Begin DoDot:1

 +22      ; Make 'big' box else make 'little' box.

 +23               IF $LENGTH(LRINFW)>10

                       SET LRZ=130_",40,40"

 +24              IF '$TEST

                       SET LRZ=10+($LENGTH(LRINFW)*12)_",25,25"

 +25               DO GB^LRLABELD(442,0,LRZ)

 +26               SET LRFONT=LRFONT_"^FR"

 +27      ; Print infection warning.

 +28               DO PL^LRLABELD(447,3,$EXTRACT(LRINFW,1,10),LRFONT)

 +29      ; Print remainder of infection warning.

 +30               IF $LENGTH(LRINFW)>10

                       DO PL^LRLABELD(447,21,$EXTRACT(LRINFW,11,20),LRFONT)

 +31               DO FONT

               End DoDot:1

 +32      ;

 +33      ; Print patient name.

 +34       SET LRFONT="^ADN,36,10"

 +35       DO PL^LRLABELD(0,0,$EXTRACT(PNM,1,25),LRFONT)

 +36       DO FONT

 +37      ;

 +38      ; Print patient identifier.

 +39       SET LRFONT="^ADN,36,10"

 +40       DO PL^LRLABELD(0,40,SSN,LRFONT)

 +41       DO FONT

 +42      ;

 +43      ; Print patient location.

 +44       DO PL^LRLABELD(200,40,"Ward: "_LRLLOC,LRFONT)

 +45      ;

 +46      ; Print room-bed number.

 +47       IF $LENGTH(LRRB)

               DO PL^LRLABELD(200,60," Bed: "_LRRB,LRFONT)

 +48      ;

 +49      ; Print accession.

 +50       DO PL^LRLABELD(0,80,LRACC,LRFONT)

 +51      ;

 +52      ; Print order number.

 +53       DO PL^LRLABELD(188,80,"Order #"_LRCE,LRFONT)

 +54      ;

 +55      ; Print Identifier.

 +56       DO PL^LRLABELD(0,100,LRUID,LRFONT)

 +57      ;

 +58      ; Print accession date.

 +59       DO PL^LRLABELD(188,100,LRDAT,LRFONT)

 +60      ;

 +61      ; Print collection sample.

 +62       IF LRXL

               IF N-I<LRXL

                   SET X=LRTOP

 +63      IF '$TEST

               SET X=LRPREF_LRTOP

 +64       DO PL^LRLABELD(0,120,$EXTRACT(X,1,55),LRFONT)

 +65      ;

 +66      ; Print list of tests

 +67       SET LRTXT=$$LRTXT^LRLABLD(.LRTS,55)

 +68       DO PL^LRLABELD(0,140,LRTXT,LRFONT)

 +69      ;

 +70       WRITE ETX

 +71      ;

 +72       QUIT 

 +73      ;

 +74      ;

LH        ; Set Label Home ("LH") parameters.

 +1       ;

 +2        SET STX=$CHAR(2)

           SET ETX=$CHAR(3)

 +3       ;

 +4       ; Set Print Orientation ("PO") to Inverted, and Label Home ("LH") parameters.

 +5        WRITE STX,"^POI^LH240,5",ETX

 +6       ;

FONT      ;

 +1       ; Default font.

 +2        SET LRFONT="^ADN"

 +3        QUIT