LRLABEL.m

LRLABEL ;SLC/TGA - PRINTS STANDARD LABELS 3.5X15/16 ;2/6/91  08:18 [ 05/06/2003  8:03 AM ]

 ;;5.2;LR;**1018,1022**;September 20, 2007

 ;;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,"^")

 ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022

 I $P($G(LRURGA),"^",2),$L($G(LRURGA),"^") W ?20,$P($G(LRURGA),"^")

 ;----- END IHS/OIT/MKK MOD LR*5.2*1022

 W:$L(LRINFW) ?27,LRINFW

 ;W !,$E(PNM,1,22),?24,$P(LRDAT," "),!,SSN,"  W:",LRLLOC,?20,$S(LRRB=0:"",1:" B:"_LRRB)

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 W !,$E(PNM,1,22),?24,"W: ",LRLLOC," ",$S(LRRB=0:"",1:" B:"_LRRB),?40,"SEX: ",SEX,!,HRCN," DOB: ",DOB  ;IHS/ANMC/CLS 11/1/95

 ;----- END IHS MODIFICATIONS

 W !

 I LRXL G SKIP:N-I<LRXL

 W LRPREF

SKIP ;W LRTOP,?15," Order:",LRCE,!

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 W LRTOP,!  ;IHS/ANMC/CLS 11/1/95

 ;----- END IHS MODIFICATIONS

 W LRTXT,!!

 Q

 ;

BAR ;Print Bar code label

 W LRACC

 ; I $P(LRURGA,"^",2),$L(LRURGA,"^") W ?15,$P(LRURGA,"^")

 ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022

 I $P($G(LRURGA),"^",2),$L($G(LRURGA),"^") W ?15,$P($G(LRURGA),"^")

 ;----- END IHS/OIT/MKK MOD LR*5.2*1022

 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

LRLABEL   ;SLC/TGA - PRINTS STANDARD LABELS 3.5X15/16 ;2/6/91  08:18 [ 05/06/2003  8:03 AM ]

 +1       ;;5.2;LR;**1018,1022**;September 20, 2007

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

 +3       ;FOR 3.5 X 15/16 LABEL

 +4        USE IO

 +5        SET LRTXT=$$LRTXT^LRLABLD(.LRTS,54)

 +6       ; Print barcode label

           IF $GET(LRBAR(+$GET(LRAA)),0)

               DO BAR

               QUIT 

 +7        WRITE LRACC

 +8       ; I $P(LRURGA,"^",2),$L(LRURGA,"^") W ?20,$P(LRURGA,"^")

 +9       ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022

 +10       IF $PIECE($GET(LRURGA),"^",2)

               IF $LENGTH($GET(LRURGA),"^")

                   WRITE ?20,$PIECE($GET(LRURGA),"^")

 +11      ;----- END IHS/OIT/MKK MOD LR*5.2*1022

 +12       IF $LENGTH(LRINFW)

               WRITE ?27,LRINFW

 +13      ;W !,$E(PNM,1,22),?24,$P(LRDAT," "),!,SSN,"  W:",LRLLOC,?20,$S(LRRB=0:"",1:" B:"_LRRB)

 +14      ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +15      ;IHS/ANMC/CLS 11/1/95

           WRITE !,$EXTRACT(PNM,1,22),?24,"W: ",LRLLOC," ",$SELECT(LRRB=0:"",1:" B:"_LRRB),?40,"SEX: ",SEX,!,HRCN," DOB: ",DOB

 +16      ;----- END IHS MODIFICATIONS

 +17       WRITE !

 +18       IF LRXL

               IF N-I<LRXL

                   GOTO SKIP

 +19       WRITE LRPREF

SKIP      ;W LRTOP,?15," Order:",LRCE,!

 +1       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +2       ;IHS/ANMC/CLS 11/1/95

           WRITE LRTOP,!

 +3       ;----- END IHS MODIFICATIONS

 +4        WRITE LRTXT,!!

 +5        QUIT 

 +6       ;

BAR       ;Print Bar code label

 +1        WRITE LRACC

 +2       ; I $P(LRURGA,"^",2),$L(LRURGA,"^") W ?15,$P(LRURGA,"^")

 +3       ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022

 +4        IF $PIECE($GET(LRURGA),"^",2)

               IF $LENGTH($GET(LRURGA),"^")

                   WRITE ?15,$PIECE($GET(LRURGA),"^")

 +5       ;----- END IHS/OIT/MKK MOD LR*5.2*1022

 +6        IF $LENGTH(LRINFW)

               WRITE ?21,LRINFW

 +7        WRITE !,$EXTRACT(PNM,1,20),?22,$PIECE(SSN,"-",3),!

 +8        IF '$LENGTH(LRBAR1)!('$LENGTH(LRBAR0))

               WRITE !

 +9        IF $LENGTH(LRBAR1)

               IF $LENGTH(LRBAR0)

                   WRITE @LRBAR1,LRBARID,@LRBAR0

 +10       IF $DATA(LRTXT)

               WRITE LRTXT

 +11       WRITE !!

 +12       QUIT