LRLABEL3.m

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 ---LRLABEL3   765     printed  Apr 09, 2024@21:18:20                                                                                                                                                                                                     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      ;