LRBARBT.m

LRBARBT ; IHS/DIR/FJE - TEST PRINT FOR INTERMEC 4100 10 PART LABEL FORMAT 12:36 ; [ 8/29/94 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

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

TEST ;prints a test label after programming the Intermec

 ;S LRACC="CH 0331 87333",LRDAT="03/31/93 14:00",LRTOP="MARBLED RED",PNM="YOKUM,HOKUM XXXXXXXXX",SSN="123-45-6789",LRLLOC="TELEMETRY",LRCE="203987",LRTXT="CHEM7",LRURG="STAT",LRAN=25

 S LRACC="CH 0331 87333",LRDAT="03/31/93 14:00",LRTOP="MARBLED RED",PNM="YOKUM,HOKUM XXXXXXXXX",HRCN="1234567",LRLLOC="TELEMETRY",LRCE="203987",LRTXT="CHEM7",LRURG="STAT",LRAN=25  ;IHS/ANMC/CLS 11/1/95

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

FLAG S:FLAG=0 LRZTXT=LRTXT S:FLAG=1 LRZTXT=".............."

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

PRT ;programs the Intermec for print mode

 W *2,"R",*3

 ;W *2,*27,"E4",*24,!,LRACC,!,LRDAT,!,LRTOP,!,$E(PNM,1,27),!,SSN,!,"W:",$E(LRLLOC,1,9),!,$E("0000",$L(LRAN),4)_LRAN,!,"Order#:",LRCE,!,$E(LRTXT,1,19) W:$L(LRTXT)>19 "..." W ! W:$D(LRURG)#2 "STAT"

 W *2,*27,"E4",*24,!,LRACC,!,LRDAT,!,LRTOP,!,$E(PNM,1,27),!,HRCN,!,"W:",$E(LRLLOC,1,9),!,$E("0000",$L(LRAN),4)_LRAN,!,"Order#:",LRCE,!,$E(LRTXT,1,19) W:$L(LRTXT)>19 "..." W ! W:$D(LRURG)#2 "STAT"  ;IHS/ANMC/CLS 11/1/95

 ;W !,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",1)'="":$P(LRTXT,";",1),1:LRZTXT),!,*3

 W !,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$S($P(LRTXT,";",1)'="":$P(LRTXT,";",1),1:LRZTXT),!,*3  ;IHS/ANMC/CLS 11/1/95

 ;W *2,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",2)'="":$P(LRTXT,";",2),1:LRZTXT),!,LRACC,!,LRDAT,!,LRTOP,!,$E(PNM,1,27),!,SSN,!,"W:",$E(LRLLOC,1,9),!,*3

 W *2,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$S($P(LRTXT,";",2)'="":$P(LRTXT,";",2),1:LRZTXT),!,LRACC,!,LRDAT,!,LRTOP,!,$E(PNM,1,27),!,HRCN,!,"W:",$E(LRLLOC,1,9),!,*3  ;IHS/ANMC/CLS 11/1/95

 W *2,"Order#:",LRCE,!,$E(LRTXT,1,26) W:$L(LRTXT)>26 "..." W ! W:$D(LRURG)#2 "STAT" W *3

 ;W *2,!,LRACC,!,LRTOP,!,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",3)'="":$P(LRTXT,";",3),1:LRZTXT),!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",4)'="":$P(LRTXT,";",4),1:LRZTXT),*3,*2,*23,*15,"S30",*12,*3

 W *2,!,LRACC,!,LRTOP,!,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$S($P(LRTXT,";",3)'="":$P(LRTXT,";",3),1:LRZTXT),!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$S($P(LRTXT,";",4)'="":$P(LRTXT,";",4),1:LRZTXT),*3,*2,*23,*15,"S30",*12,*3

 ;K FLAG,LRACC,LRAN,LRCE,LRDAT,LRLPNM,LRTOP,LRTXT,LRZTXT,LRURG,PNM,SSN

 K FLAG,LRACC,LRAN,LRCE,LRDAT,LRLPNM,LRTOP,LRTXT,LRZTXT,LRURG,PNM,SSN,HRCN  ;IHS/ANMC/CLS 11/1/95

 Q

LRBARBT   ; IHS/DIR/FJE - TEST PRINT FOR INTERMEC 4100 10 PART LABEL FORMAT 12:36 ; [ 8/29/94 ]

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

TEST      ;prints a test label after programming the Intermec

 +1       ;S LRACC="CH 0331 87333",LRDAT="03/31/93 14:00",LRTOP="MARBLED RED",PNM="YOKUM,HOKUM XXXXXXXXX",SSN="123-45-6789",LRLLOC="TELEMETRY",LRCE="203987",LRTXT="CHEM7",LRURG="STAT",LRAN=25

 +2       ;IHS/ANMC/CLS 11/1/95

           SET LRACC="CH 0331 87333"

           SET LRDAT="03/31/93 14:00"

           SET LRTOP="MARBLED RED"

           SET PNM="YOKUM,HOKUM XXXXXXXXX"

           SET HRCN="1234567"

           SET LRLLOC="TELEMETRY"

           SET LRCE="203987"

           SET LRTXT="CHEM7"

           SET LRURG="STAT"

           SET LRAN=25

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

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

FLAG       IF FLAG=0

               SET LRZTXT=LRTXT

           IF FLAG=1

               SET LRZTXT=".............."

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

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

PRT       ;programs the Intermec for print mode

 +1        WRITE *2,"R",*3

 +2       ;W *2,*27,"E4",*24,!,LRACC,!,LRDAT,!,LRTOP,!,$E(PNM,1,27),!,SSN,!,"W:",$E(LRLLOC,1,9),!,$E("0000",$L(LRAN),4)_LRAN,!,"Order#:",LRCE,!,$E(LRTXT,1,19) W:$L(LRTXT)>19 "..." W ! W:$D(LRURG)#2 "STAT"

 +3       ;IHS/ANMC/CLS 11/1/95

           WRITE *2,*27,"E4",*24,!,LRACC,!,LRDAT,!,LRTOP,!,$EXTRACT(PNM,1,27),!,HRCN,!,"W:",$EXTRACT(LRLLOC,1,9),!,$EXTRACT("0000",$LENGTH(LRAN),4)_LRAN,!,"Order#:",LRCE,!,$EXTRACT(LRTXT,1,19)

           IF $LENGTH(LRTXT)>19

               WRITE "..."

           WRITE !

           IF $DATA(LRURG)#2

               WRITE "STAT"

 +4       ;W !,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",1)'="":$P(LRTXT,";",1),1:LRZTXT),!,*3

 +5       ;IHS/ANMC/CLS 11/1/95

           WRITE !,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$SELECT($PIECE(LRTXT,";",1)'="":$PIECE(LRTXT,";",1),1:LRZTXT),!,*3

 +6       ;W *2,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",2)'="":$P(LRTXT,";",2),1:LRZTXT),!,LRACC,!,LRDAT,!,LRTOP,!,$E(PNM,1,27),!,SSN,!,"W:",$E(LRLLOC,1,9),!,*3

 +7       ;IHS/ANMC/CLS 11/1/95

           WRITE *2,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$SELECT($PIECE(LRTXT,";",2)'="":$PIECE(LRTXT,";",2),1:LRZTXT),!,LRACC,!,LRDAT,!,LRTOP,!,$EXTRACT(PNM,1,27),!,HRCN,!,"W:",$EXTRACT(LRLLOC,1,9),!,*3

 +8        WRITE *2,"Order#:",LRCE,!,$EXTRACT(LRTXT,1,26)

           IF $LENGTH(LRTXT)>26

               WRITE "..."

           WRITE !

           IF $DATA(LRURG)#2

               WRITE "STAT"

           WRITE *3

 +9       ;W *2,!,LRACC,!,LRTOP,!,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",3)'="":$P(LRTXT,";",3),1:LRZTXT),!,LRACC,!,LRLPNM,!,SSN,!,LRDAT,!,$S($P(LRTXT,";",4)'="":$P(LRTXT,";",4),1:LRZTXT),*3,*2,*23,*15,"S30",*12,*3

 +10      WRITE *2,!,LRACC,!,LRTOP,!,LRACC,!,LRTOP,!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$SELECT($PIECE(LRTXT,";",3)'="":$PIECE(LRTXT,";",3),1:LRZTXT),!,LRACC,!,LRLPNM,!,HRCN,!,LRDAT,!,$SELECT($PIECE(LRTXT,";",4)'="":...

           ... $PIECE(LRTXT,";",4),1:LRZTXT),*3,*2,*23,*15,"S30",*12,*3

 +11      ;K FLAG,LRACC,LRAN,LRCE,LRDAT,LRLPNM,LRTOP,LRTXT,LRZTXT,LRURG,PNM,SSN

 +12      ;IHS/ANMC/CLS 11/1/95

           KILL FLAG,LRACC,LRAN,LRCE,LRDAT,LRLPNM,LRTOP,LRTXT,LRZTXT,LRURG,PNM,SSN,HRCN

 +13       QUIT