LRLABEL5.m

LRLABEL5 ;DUR/KT/AT - PRINTS ON VAF 10-1392 LABELS ;2/6/91  08:05

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

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

A U IO

 S LRTXT=$$LRTXT^LRLABLD(.LRTS,IOM-1)

 W LRACC

 W:$D(LRURG) ?16,"Stat"

 W:$L(LRINFW) ?21,LRINFW

 W ?33,LRACC,?56,LRACC

 W !,$E(PNM,1,20),?21,$E(LRDAT,1,2)_$E(LRDAT,4,5)_$E(LRDAT,7,8),?33,$E(PNM,1,20),?56,$E(PNM,1,20)

 W !,SSN,"  W:",LRLLOC,?20,$S(LRRB=0:"",1:" B:"_LRRB),?33,SSN,?56,SSN

 W !

 I LRXL G SKIP:N-I<LRXL

 W LRPREF

SKIP W LRTOP,?15," Order:",LRCE,?33,"Order:",LRCE,?56,"Order:",LRCE,!

 W $E(LRTXT,1,IOM-1),!!

 Q:'$D(LRAA)

 Q:'$D(LRBAR(LRAA))

 ;

BAR ;Print bar code label

 W LRACC W:$D(LRURG) ?16,"Stat" W:$L(LRINFW) ?21,LRINFW

 W !,$E(PNM,1,20),?21,$E(LRDAT,1,2)_$E(LRDAT,4,5)_$E(LRDAT,7,8)

 W !,SSN,"  W:",LRLLOC,?20,$S(LRRB=0:"",1:" B:"_LRRB)

 W !,$E(LRTXT,1,IOM-1),!

 W @LRBAR1,LRBARID,@LRBAR0

 W !

 Q

LRLABEL5  ;DUR/KT/AT - PRINTS ON VAF 10-1392 LABELS ;2/6/91  08:05

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

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

A          USE IO

 +1        SET LRTXT=$$LRTXT^LRLABLD(.LRTS,IOM-1)

 +2        WRITE LRACC

 +3        IF $DATA(LRURG)

               WRITE ?16,"Stat"

 +4        IF $LENGTH(LRINFW)

               WRITE ?21,LRINFW

 +5        WRITE ?33,LRACC,?56,LRACC

 +6        WRITE !,$EXTRACT(PNM,1,20),?21,$EXTRACT(LRDAT,1,2)_$EXTRACT(LRDAT,4,5)_$EXTRACT(LRDAT,7,8),?33,$EXTRACT(PNM,1,20),?56,$EXTRACT(PNM,1,20)

 +7        WRITE !,SSN,"  W:",LRLLOC,?20,$SELECT(LRRB=0:"",1:" B:"_LRRB),?33,SSN,?56,SSN

 +8        WRITE !

 +9        IF LRXL

               IF N-I<LRXL

                   GOTO SKIP

 +10       WRITE LRPREF

SKIP       WRITE LRTOP,?15," Order:",LRCE,?33,"Order:",LRCE,?56,"Order:",LRCE,!

 +1        WRITE $EXTRACT(LRTXT,1,IOM-1),!!

 +2        IF '$DATA(LRAA)

               QUIT 

 +3        IF '$DATA(LRBAR(LRAA))

               QUIT 

 +4       ;

BAR       ;Print bar code label

 +1        WRITE LRACC

           IF $DATA(LRURG)

               WRITE ?16,"Stat"

           IF $LENGTH(LRINFW)

               WRITE ?21,LRINFW

 +2        WRITE !,$EXTRACT(PNM,1,20),?21,$EXTRACT(LRDAT,1,2)_$EXTRACT(LRDAT,4,5)_$EXTRACT(LRDAT,7,8)

 +3        WRITE !,SSN,"  W:",LRLLOC,?20,$SELECT(LRRB=0:"",1:" B:"_LRRB)

 +4        WRITE !,$EXTRACT(LRTXT,1,IOM-1),!

 +5        WRITE @LRBAR1,LRBARID,@LRBAR0

 +6        WRITE !

 +7        QUIT