source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLABEL1.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 941 bytes
Line 
1LRLABEL1 ;SLC/TGA - PRINTS LABELS 2X5 UNEVEN ;2/6/91 08:18
2 ;;5.2;LAB SERVICE;**161**;Sep 27, 1994
3 ;For the 10 part SLC label at 16.5 CPI, With 1 label per 4 tests.
41 U IO
5 S LRDAT=$P(LRDAT," ")
6 S LRTXT=$$LRTXT^LRLABLD(.LRTS,45)
7 S A=0,T=1
8 F C=1:1:T D T,T1
9 Q
10 ;
11T W !,$E(PNM,1,$S($L(LRINFW):18,1:28)),@$S($L(LRINFW):"?19",1:"?28"),LRINFW
12 W ?30,LRACC
13 F J=1:1:4 W ?(J*22+27),LRACC
14 W !,SSN," W:",$E(LRLLOC,1,17),?33,LRDAT F J=1:1:4 W ?(J*22+27),LRDAT
15 W ! I LRXL G SKIP:N-I<LRXL
16 W LRPREF
17SKIP W LRTOP,?15," Order:",LRCE
18 S LRLPNM=$P(PNM,",",1),LRLPNM=LRLPNM_$S($L(LRLPNM)<17:","_$E($P(PNM,",",2),1),1:"")
19 F J=1:1:4 W ?(J*22+27),$E(LRLPNM,1,17)
20 K LRLPNM
21 W !,LRTXT
22 F J=1:1:4 W ?(J*22+27),$E(LRTOP,1,17)
23 Q
24 ;
25T1 W:'$L($G(LRBAR1)) !
26 W !,$E(PNM,1,28) W ?30,LRACC
27 F J=1:1:4 W ?(J*22+27),LRACC
28 W !,SSN," W:",$E(LRLLOC,1,17),?33,LRDAT
29 F J=1:1:4 W ?(J*22+27),LRDAT
30 W:'$L($G(LRBAR1)) !!
31 W:$L($G(LRBAR1)) !,@LRBAR1,LRBARID,@LRBAR0,!
Note: See TracBrowser for help on using the repository browser.