LRLABEL ;SLC/TGA - PRINTS STANDARD LABELS 3.5X15/16 ;2/6/91 08:18
;;5.2;LAB SERVICE;**161**;Sep 27, 1994
;FOR 3.5 X 15/16 LABEL
U IO
S LRTXT=$$LRTXT^LRLABLD(.LRTS,54)
I $G(LRBAR(+$G(LRAA)),0) D BAR Q ; Print barcode label
W LRACC
I $P(LRURGA,"^",2),$L(LRURGA,"^") W ?20,$P(LRURGA,"^")
W:$L(LRINFW) ?27,LRINFW
W !,$E(PNM,1,22),?24,$P(LRDAT," "),!,SSN," W:",LRLLOC,?20,$S(LRRB=0:"",1:" B:"_LRRB)
W !
I LRXL G SKIP:N-I<LRXL
W LRPREF
SKIP W LRTOP,?15," Order:",LRCE,!
W LRTXT,!!
Q
;
BAR ;Print Bar code label
W LRACC
I $P(LRURGA,"^",2),$L(LRURGA,"^") W ?15,$P(LRURGA,"^")
W:$L(LRINFW) ?21,LRINFW
W !,$E(PNM,1,20),?22,$P(SSN,"-",3),!
W:'$L(LRBAR1)!('$L(LRBAR0)) !
I $L(LRBAR1),$L(LRBAR0) W @LRBAR1,LRBARID,@LRBAR0
W:$D(LRTXT) LRTXT
W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLABEL 788 printed Sep 23, 2025@19:51:31 Page 2
LRLABEL ;SLC/TGA - PRINTS STANDARD LABELS 3.5X15/16 ;2/6/91 08:18
+1 ;;5.2;LAB SERVICE;**161**;Sep 27, 1994
+2 ;FOR 3.5 X 15/16 LABEL
+3 USE IO
+4 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,54)
+5 ; Print barcode label
IF $GET(LRBAR(+$GET(LRAA)),0)
DO BAR
QUIT
+6 WRITE LRACC
+7 IF $PIECE(LRURGA,"^",2)
IF $LENGTH(LRURGA,"^")
WRITE ?20,$PIECE(LRURGA,"^")
+8 if $LENGTH(LRINFW)
WRITE ?27,LRINFW
+9 WRITE !,$EXTRACT(PNM,1,22),?24,$PIECE(LRDAT," "),!,SSN," W:",LRLLOC,?20,$SELECT(LRRB=0:"",1:" B:"_LRRB)
+10 WRITE !
+11 IF LRXL
if N-I<LRXL
GOTO SKIP
+12 WRITE LRPREF
SKIP WRITE LRTOP,?15," Order:",LRCE,!
+1 WRITE LRTXT,!!
+2 QUIT
+3 ;
BAR ;Print Bar code label
+1 WRITE LRACC
+2 IF $PIECE(LRURGA,"^",2)
IF $LENGTH(LRURGA,"^")
WRITE ?15,$PIECE(LRURGA,"^")
+3 if $LENGTH(LRINFW)
WRITE ?21,LRINFW
+4 WRITE !,$EXTRACT(PNM,1,20),?22,$PIECE(SSN,"-",3),!
+5 if '$LENGTH(LRBAR1)!('$LENGTH(LRBAR0))
WRITE !
+6 IF $LENGTH(LRBAR1)
IF $LENGTH(LRBAR0)
WRITE @LRBAR1,LRBARID,@LRBAR0
+7 if $DATA(LRTXT)
WRITE LRTXT
+8 WRITE !!
+9 QUIT
