LRLABEL3 ;SLC/RWF - PRINTS MEDLAB LABELS ;2/6/91 08:06
;;5.2;LAB SERVICE;**161**;Sep 27, 1994
;For the 7 part MEDLAB label DPS-ML (time products) AT 16.5 CPI
1 U IO S T=45,T1=23,X=136 X ^%ZOSF("RM") ; Set T=28, T1=14 for 10 cpi.
S LRDAT=$P(LRDAT," ")
S LRTXT=$$LRTXT^LRLABLD(.LRTS,25)
S B=$S(LRRB=0:"",1:" B:"_LRRB)
D T
Q
;
T S X=$E(PNM,1,$S($L(LRINFW):18,1:T-1))
W !
F J=0:1:2 W ?(J*T),X W:$L(LRINFW) " ",LRINFW
S J1=N-I'<LRXL
W ! S X=T-2-$L(LRACC) F J=0:1:2 W ?(J*T),LRACC,$J("W:"_LRLLOC_B,X)
W ! S X=T-2-$L(SSN) F J=0:1:2 W ?(J*T),SSN,$J(LRDAT,X)
W ! F J=0:1:2 W:J1 ?(J*T),LRPREF W ?(J*T+6),LRTOP,?(J*T+15)," Order:",LRCE
W !,LRTXT
W ! F J=0:1:3 W ?(J*T1+T),LRACC
W ! F J=0:1:3 W ?(J*T1+T),LRDAT
W !!
K J,J1,I1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLABEL3 765 printed Dec 13, 2024@02:15:55 Page 2
LRLABEL3 ;SLC/RWF - PRINTS MEDLAB LABELS ;2/6/91 08:06
+1 ;;5.2;LAB SERVICE;**161**;Sep 27, 1994
+2 ;For the 7 part MEDLAB label DPS-ML (time products) AT 16.5 CPI
1 ; Set T=28, T1=14 for 10 cpi.
USE IO
SET T=45
SET T1=23
SET X=136
XECUTE ^%ZOSF("RM")
+1 SET LRDAT=$PIECE(LRDAT," ")
+2 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,25)
+3 SET B=$SELECT(LRRB=0:"",1:" B:"_LRRB)
+4 DO T
+5 QUIT
+6 ;
T SET X=$EXTRACT(PNM,1,$SELECT($LENGTH(LRINFW):18,1:T-1))
+1 WRITE !
+2 FOR J=0:1:2
WRITE ?(J*T),X
if $LENGTH(LRINFW)
WRITE " ",LRINFW
+3 SET J1=N-I'<LRXL
+4 WRITE !
SET X=T-2-$LENGTH(LRACC)
FOR J=0:1:2
WRITE ?(J*T),LRACC,$JUSTIFY("W:"_LRLLOC_B,X)
+5 WRITE !
SET X=T-2-$LENGTH(SSN)
FOR J=0:1:2
WRITE ?(J*T),SSN,$JUSTIFY(LRDAT,X)
+6 WRITE !
FOR J=0:1:2
if J1
WRITE ?(J*T),LRPREF
WRITE ?(J*T+6),LRTOP,?(J*T+15)," Order:",LRCE
+7 WRITE !,LRTXT
+8 WRITE !
FOR J=0:1:3
WRITE ?(J*T1+T),LRACC
+9 WRITE !
FOR J=0:1:3
WRITE ?(J*T1+T),LRDAT
+10 WRITE !!
+11 KILL J,J1,I1
+12 QUIT
+13 ;
