LRLABEL6 ;SLC/FHS - BAR CODE LABELS FOR THE INTERMEC PRINTER ;8/29/94 12:36
;;5.2;LAB SERVICE;**161**;Sep 27, 1994
;This routine is similar to automated instrument
;*R are use to read the printer's response, not a user's input.
;Designed on a 8646 thermal transfer printer
;Charater set=USA,Batch=disable,self test=disable
;Baud=9600,parity=even,label stock=regular,control mode=computer
;Protocol Command=User interface,format Rotation=breech,right margin=disable
;bar width=10 mil LABEL SIZE= 1X3 IN. Part No 049114
;top dip sw=all 5 off :mid dip sw=1 on 2-7 off
;bottom dip sw 1-2 off,3-4 on,5 off,6 on,7-8 off
EN ;
I PNM="TEST, LABEL" D TEST^LRLABAR Q
P Q:N<1 S:'$D(LRAN) LRAN=100 S LRURG=$S($D(LRURG0):$P(^LAB(62.05,LRURG0,0),U),1:"ROUTINE")
S LRTXT=$$LRTXT^LRLABLD(.LRTS,34)
D PRT
Q:$S('$D(LRBAR):1,'$D(LRAA):1,'$D(LRBAR(LRAA)):1,1:0) ;QUIT IF NO BAR CODE
BAR D ENQ W $C(2),"R",$C(3) D ENQ
W $C(2,27),"E3",$C(24),$E(PNM,1,30)_" "_$P(SSN,"-",3),!,$E(LRINFW,1,20),!,LRTXT,!,LRACC_$S($D(LRURG):" <"_LRURG_"> ",1:" ")_"LOC:"_LRLLOC,!,$E(LRACC,1,2),!,LRBARID,$C(30),1,$C(23,3) D ENQ
Q
PRT D ENQ W $C(2),"R",$C(3) D ENQ
W $C(2,27),"E2",$C(24),$E(PNM,1,30)_" "_$P(SSN,"-",3),!,$E(LRINFW,1,20)_" ORD:"_$S($D(LRCE):LRCE,1:""),!,LRTXT,!,LRACC_$S($D(LRURG):" <"_LRURG_"> ",1:" ")_"LOC:"_LRLLOC,!,LRTOP_" "_LRPREF,$C(30),1,$C(23,3) D ENQ
Q
ENQ ;
W $C(5) R *X:1 Q:X=-1!(X=18)!(X=81)!(X=31)!(X=25)!(X=68)
F R *X:1 Q:X=-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLABEL6 1478 printed Dec 13, 2024@02:15:56 Page 2
LRLABEL6 ;SLC/FHS - BAR CODE LABELS FOR THE INTERMEC PRINTER ;8/29/94 12:36
+1 ;;5.2;LAB SERVICE;**161**;Sep 27, 1994
+2 ;This routine is similar to automated instrument
+3 ;*R are use to read the printer's response, not a user's input.
+4 ;Designed on a 8646 thermal transfer printer
+5 ;Charater set=USA,Batch=disable,self test=disable
+6 ;Baud=9600,parity=even,label stock=regular,control mode=computer
+7 ;Protocol Command=User interface,format Rotation=breech,right margin=disable
+8 ;bar width=10 mil LABEL SIZE= 1X3 IN. Part No 049114
+9 ;top dip sw=all 5 off :mid dip sw=1 on 2-7 off
+10 ;bottom dip sw 1-2 off,3-4 on,5 off,6 on,7-8 off
EN ;
+1 IF PNM="TEST, LABEL"
DO TEST^LRLABAR
QUIT
P if N<1
QUIT
if '$DATA(LRAN)
SET LRAN=100
SET LRURG=$SELECT($DATA(LRURG0):$PIECE(^LAB(62.05,LRURG0,0),U),1:"ROUTINE")
+1 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,34)
+2 DO PRT
+3 ;QUIT IF NO BAR CODE
if $SELECT('$DATA(LRBAR)
QUIT
BAR DO ENQ
WRITE $CHAR(2),"R",$CHAR(3)
DO ENQ
+1 WRITE $CHAR(2,27),"E3",$CHAR(24),$EXTRACT(PNM,1,30)_" "_$PIECE(SSN,"-",3),!,$EXTRACT(LRINFW,1,20),!,LRTXT,!,LRACC_$SELECT($DATA(LRURG):" <"_LRURG_"> ",1:" ")_"LOC:"_LRLLOC,!,$EXTRACT(LRACC,1,2),!,LRBARID,$CHAR(30),1,$CHAR(23,3)
DO ENQ
+2 QUIT
PRT DO ENQ
WRITE $CHAR(2),"R",$CHAR(3)
DO ENQ
+1 WRITE $CHAR(2,27),"E2",$CHAR(24),$EXTRACT(PNM,1,30)_" "_$PIECE(SSN,"-",3),!,$EXTRACT(LRINFW,1,20)_" ORD:"_$SELECT($DATA(LRCE):LRCE,1:""),!,LRTXT,!,LRACC_$SELECT($DATA(LRURG):" <"_LRURG_"> ",1:" ")_"LOC:"_LRLLOC,!,LRTOP_" "_LRPREF,...
... $CHAR(30),1,$CHAR(23,3)
DO ENQ
+2 QUIT
ENQ ;
+1 WRITE $CHAR(5)
READ *X:1
if X=-1!(X=18)!(X=81)!(X=31)!(X=25)!(X=68)
QUIT
+2 FOR
READ *X:1
if X=-1
QUIT
+3 QUIT
