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 ---[H[J[2J[HLRLABEL1 972 printed Sep 23, 2025@19:51:32 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,!
