LRLABEL1.m

LRLABEL1 ;SLC/TGA - PRINTS LABELS 2X5 UNEVEN ;2/6/91  08:18

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

 ;For the 10 part SLC label at 16.5 CPI, With 1 label per 4 tests.

1 U IO

 S LRDAT=$P(LRDAT," ")

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

 S A=0,T=1

 F C=1:1:T D T,T1

 Q

 ;

T W !,$E(PNM,1,$S($L(LRINFW):18,1:28)),@$S($L(LRINFW):"?19",1:"?28"),LRINFW

 W ?30,LRACC

 F J=1:1:4 W ?(J*22+27),LRACC

 W !,SSN,"  W:",$E(LRLLOC,1,17),?33,LRDAT F J=1:1:4 W ?(J*22+27),LRDAT

 W ! I LRXL G SKIP:N-I<LRXL

 W LRPREF

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

 S LRLPNM=$P(PNM,",",1),LRLPNM=LRLPNM_$S($L(LRLPNM)<17:","_$E($P(PNM,",",2),1),1:"")

 F J=1:1:4 W ?(J*22+27),$E(LRLPNM,1,17)

 K LRLPNM

 W !,LRTXT

 F J=1:1:4 W ?(J*22+27),$E(LRTOP,1,17)

 Q

 ;

T1 W:'$L($G(LRBAR1)) !

 W !,$E(PNM,1,28) W ?30,LRACC

 F J=1:1:4 W ?(J*22+27),LRACC

 W !,SSN,"  W:",$E(LRLLOC,1,17),?33,LRDAT

 F J=1:1:4 W ?(J*22+27),LRDAT

 W:'$L($G(LRBAR1)) !!

 W:$L($G(LRBAR1)) !,@LRBAR1,LRBARID,@LRBAR0,!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRLABEL1   972     printed  Apr 09, 2024@21:20:50                                                                                                                                                                                                     Page 2

LRLABEL1  ;SLC/TGA - PRINTS LABELS 2X5 UNEVEN ;2/6/91  08:18

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

 +2       ;For the 10 part SLC label at 16.5 CPI, With 1 label per 4 tests.

1          USE IO

 +1        SET LRDAT=$PIECE(LRDAT," ")

 +2        SET LRTXT=$$LRTXT^LRLABLD(.LRTS,45)

 +3        SET A=0

           SET T=1

 +4        FOR C=1:1:T

               DO T

               DO T1

 +5        QUIT 

 +6       ;

T          WRITE !,$EXTRACT(PNM,1,$SELECT($LENGTH(LRINFW):18,1:28)),@$SELECT($LENGTH(LRINFW):"?19",1:"?28"),LRINFW

 +1        WRITE ?30,LRACC

 +2        FOR J=1:1:4

               WRITE ?(J*22+27),LRACC

 +3        WRITE !,SSN,"  W:",$EXTRACT(LRLLOC,1,17),?33,LRDAT

           FOR J=1:1:4

               WRITE ?(J*22+27),LRDAT

 +4        WRITE !

           IF LRXL

               if N-I<LRXL

                   GOTO SKIP

 +5        WRITE LRPREF

SKIP       WRITE LRTOP,?15," Order:",LRCE

 +1        SET LRLPNM=$PIECE(PNM,",",1)

           SET LRLPNM=LRLPNM_$SELECT($LENGTH(LRLPNM)<17:","_$EXTRACT($PIECE(PNM,",",2),1),1:"")

 +2        FOR J=1:1:4

               WRITE ?(J*22+27),$EXTRACT(LRLPNM,1,17)

 +3        KILL LRLPNM

 +4        WRITE !,LRTXT

 +5        FOR J=1:1:4

               WRITE ?(J*22+27),$EXTRACT(LRTOP,1,17)

 +6        QUIT 

 +7       ;

T1         if '$LENGTH($GET(LRBAR1))

               WRITE !

 +1        WRITE !,$EXTRACT(PNM,1,28)

           WRITE ?30,LRACC

 +2        FOR J=1:1:4

               WRITE ?(J*22+27),LRACC

 +3        WRITE !,SSN,"  W:",$EXTRACT(LRLLOC,1,17),?33,LRDAT

 +4        FOR J=1:1:4

               WRITE ?(J*22+27),LRDAT

 +5        if '$LENGTH($GET(LRBAR1))

               WRITE !!

 +6        if $LENGTH($GET(LRBAR1))

               WRITE !,@LRBAR1,LRBARID,@LRBAR0,!