- 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 Mar 13, 2025@21:20:12 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
