RMPRPI11 ;HIN/ODJ-PRINT BAR CODE LABELS ;10/8/02 13:11
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
;
Q
;
;***** SELP - Prompt for Bar Code printer
SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ;
N POP
START S %ZIS("A")="Select Bar Code Printer: "
S %ZIS("B")=""
S %ZIS="QN" K IOP
D ^%ZIS
S RMPRQ=0
S RMPREXC=""
I POP S RMPREXC="P" G SELPX
I '$D(IO("Q")) D G SELPX
. S RMPRBCP=$G(IOST)
. S:RMPRBCP="" RMPREXC="^"
. S RMPRIOP=$G(ION)
. Q
;I '$D(IO("Q")) U IO D TEST G SELPX
;K IO("Q") S ZTDESC="SLAVE PRINT TEST"
;S ZTRTN="TEST^RMPRPI11",ZTIO=ION
;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX
SELPX Q
TEST S IOP=ION,%ZIS="" D ^%ZIS
W !!,"TESTING SLAVE DEVICE",!!
W @IOF
D ^%ZISC
Q
;
; Print bar code for printer using ZPLII command set (ZEBRAS)
; applies to Z4000 and all Zebra printers.
ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ;
N RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRMMIN
N RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF
N RMPRLEFT,RMPRDOWN,RMPRLCNT
S RMPRUNIT="MM" ; use mm units
S RMPRLTYP="" ; <not used yet>
S RMPRLWID=75 ; Lable width 75mm
S RMPRLHGT=25 ; Label height 25mm
;if printer resolution not defined in terminal type file,
;default to 8 dpm
I '$G(RMPRLRES) S RMPRLRES=8 ; 8 for 203dpi & 12 for 300dpi
S RMPRMMIN=25.333 ; mm to the inch conversion factor
I '+$G(RMPRNCOP) S RMPRNCOP=1
;
; Set the X dimension in dots (width of narrow bar)
; minimum recommended X dimension is .25mm (7.5/1000th inch)
I RMPRUNIT="MM" D
. S RMPRXDIM=RMPRLRES*.25
. Q
I RMPRUNIT="IN" D
. S RMPRXDIM=RMPRLRES*.0075
. Q
S:RMPRXDIM'=(RMPRXDIM\1) RMPRXDIM=.5+(RMPRXDIM\1)
;
; Calculate the quiet zone in dots
; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch)
I RMPRUNIT="MM" D
. S RMPRQUIZ=((2.5333*RMPRLRES)\1)+1
. S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM
. Q
I RMPRUNIT="IN" D
. S RMPRQUIZ=((.1*RMPRLRES)\1)+1
. S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM
. Q
;
; Calculate length (in dots) of symbol to be printed
; Symbol is [HCPCS code][-][Date and Time]
; [HCPCS code] and [-] will be alphanumeric
; [Date and Time] will be numeric using code C
S RMPRHCPC=$P(RMPRBARC,"-",1)
S RMPRBLEN=((11*($L(RMPRHCPC)+5))+35)*RMPRXDIM
S RMPRDT=$P(RMPRBARC,"-",2)
S RMPRBLEN=RMPRBLEN+(((5.5*($L(RMPRDT)))+35)*RMPRXDIM)
;
; Calculate bar height in dots
; this should be .15 times symbol length or .25 inches
I RMPRUNIT="MM" D
. S RMPRBHGT=((6.33325*RMPRLRES)\1)+2
. S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=2+((.15*RMPRBLEN)\1)
. Q
I RMPRUNIT="IN" D
. S RMPRBHGT=((.25*RMPRLRES)\1)+2
. S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=2+((.15*RMPRBLEN)\1)
. Q
;
; *** Print the symbol ***
S RMPRCRLF=$C(13)_$C(10)
S RMPRLCNT=0
I '$D(RMPR("NAME")),$D(RMPRITXT("NAME")) S RMPR("NAME")=RMPRITXT("NAME")
I '$D(RMPR("NAME")),$D(RMPRSTN("SITE NAME")) S RMPR("NAME")=RMPRSTN("SITE NAME")
I '$D(RMPR("NAME")) S RMPR("NAME")=""
ZPLIIP W "^XA",RMPRCRLF
W "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF
W "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF
S RMPRLEFT=RMPRQUIZ+5
S RMPRDOWN=(RMPRQUIZ\2)-10
;
; the BAR CODE
W "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF
S RMPRDOWN=RMPRDOWN+((1.33*RMPRBHGT)\1)
;
; Description fields
S RMPRIND=RMPRLEFT+20
S RMPRITXT("DT")=$E(RMPRITXT("DATE"),1,6)_$E(RMPRITXT("DATE"),9,10)
W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
W:RMPRLRES=12 "^AE,^FD"_$E(RMPRITXT("ITEM")_$J("",12),1,12)_$E("$ "_$J(RMPRITXT("UNIT PRICE"),0,2)_$J("",10),1,10)_" "_RMPRITXT("DT")_"^FS",RMPRCRLF
W:RMPRLRES=8 "^AF,^FD"_$E(RMPRITXT("ITEM")_$J("",12),1,12)_$E("$ "_$J(RMPRITXT("UNIT PRICE"),0,2)_$J("",10),1,10)_" "_RMPRITXT("DT")_"^FS",RMPRCRLF
S RMPRDOWN=RMPRDOWN+14+(RMPRQUIZ\1.5)
W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
W:RMPRLRES=12 "^AF^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
W:RMPRLRES=8 "^AD^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
S RMPRDOWN=RMPRDOWN+10+(RMPRQUIZ\1.5)
W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
W "^AF^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF
S RMPRDOWN=RMPRDOWN+8+(RMPRQUIZ\1.5)
W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
W:RMPRLRES=12 "^AF^FD"_$E(RMPRITXT("VENDOR"),1,18)_" # "_$E(RMPRITXT("LOCATION"),1,18)_" # "_$E(RMPR("NAME"),1,15)_"^FS",RMPRCRLF
W:RMPRLRES=8 "^AD^FD"_$E(RMPRITXT("VENDOR"),1,18)_" # "_$E(RMPRITXT("LOCATION"),1,18)_" # "_$E(RMPR("NAME"),1,15)_"^FS",RMPRCRLF
;W:RMPRLRES=8 "^AD^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF
;
; finish
W "^XZ",RMPRCRLF
S RMPRLCNT=1+RMPRLCNT
I RMPRLCNT<RMPRNCOP G ZPLIIP
ZPLIIX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPI11 4651 printed Sep 23, 2025@20:12:14 Page 2
RMPRPI11 ;HIN/ODJ-PRINT BAR CODE LABELS ;10/8/02 13:11
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 ;
+3 QUIT
+4 ;
+5 ;***** SELP - Prompt for Bar Code printer
SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ;
+1 NEW POP
START SET %ZIS("A")="Select Bar Code Printer: "
+1 SET %ZIS("B")=""
+2 SET %ZIS="QN"
KILL IOP
+3 DO ^%ZIS
+4 SET RMPRQ=0
+5 SET RMPREXC=""
+6 IF POP
SET RMPREXC="P"
GOTO SELPX
+7 IF '$DATA(IO("Q"))
Begin DoDot:1
+8 SET RMPRBCP=$GET(IOST)
+9 if RMPRBCP=""
SET RMPREXC="^"
+10 SET RMPRIOP=$GET(ION)
+11 QUIT
End DoDot:1
GOTO SELPX
+12 ;I '$D(IO("Q")) U IO D TEST G SELPX
+13 ;K IO("Q") S ZTDESC="SLAVE PRINT TEST"
+14 ;S ZTRTN="TEST^RMPRPI11",ZTIO=ION
+15 ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX
SELPX QUIT
TEST SET IOP=ION
SET %ZIS=""
DO ^%ZIS
+1 WRITE !!,"TESTING SLAVE DEVICE",!!
+2 WRITE @IOF
+3 DO ^%ZISC
+4 QUIT
+5 ;
+6 ; Print bar code for printer using ZPLII command set (ZEBRAS)
+7 ; applies to Z4000 and all Zebra printers.
ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ;
+1 NEW RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRMMIN
+2 NEW RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF
+3 NEW RMPRLEFT,RMPRDOWN,RMPRLCNT
+4 ; use mm units
SET RMPRUNIT="MM"
+5 ; <not used yet>
SET RMPRLTYP=""
+6 ; Lable width 75mm
SET RMPRLWID=75
+7 ; Label height 25mm
SET RMPRLHGT=25
+8 ;if printer resolution not defined in terminal type file,
+9 ;default to 8 dpm
+10 ; 8 for 203dpi & 12 for 300dpi
IF '$GET(RMPRLRES)
SET RMPRLRES=8
+11 ; mm to the inch conversion factor
SET RMPRMMIN=25.333
+12 IF '+$GET(RMPRNCOP)
SET RMPRNCOP=1
+13 ;
+14 ; Set the X dimension in dots (width of narrow bar)
+15 ; minimum recommended X dimension is .25mm (7.5/1000th inch)
+16 IF RMPRUNIT="MM"
Begin DoDot:1
+17 SET RMPRXDIM=RMPRLRES*.25
+18 QUIT
End DoDot:1
+19 IF RMPRUNIT="IN"
Begin DoDot:1
+20 SET RMPRXDIM=RMPRLRES*.0075
+21 QUIT
End DoDot:1
+22 if RMPRXDIM'=(RMPRXDIM\1)
SET RMPRXDIM=.5+(RMPRXDIM\1)
+23 ;
+24 ; Calculate the quiet zone in dots
+25 ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch)
+26 IF RMPRUNIT="MM"
Begin DoDot:1
+27 SET RMPRQUIZ=((2.5333*RMPRLRES)\1)+1
+28 if RMPRQUIZ<(10*RMPRXDIM)
SET RMPRQUIZ=10*RMPRXDIM
+29 QUIT
End DoDot:1
+30 IF RMPRUNIT="IN"
Begin DoDot:1
+31 SET RMPRQUIZ=((.1*RMPRLRES)\1)+1
+32 if RMPRQUIZ<(10*RMPRXDIM)
SET RMPRQUIZ=10*RMPRXDIM
+33 QUIT
End DoDot:1
+34 ;
+35 ; Calculate length (in dots) of symbol to be printed
+36 ; Symbol is [HCPCS code][-][Date and Time]
+37 ; [HCPCS code] and [-] will be alphanumeric
+38 ; [Date and Time] will be numeric using code C
+39 SET RMPRHCPC=$PIECE(RMPRBARC,"-",1)
+40 SET RMPRBLEN=((11*($LENGTH(RMPRHCPC)+5))+35)*RMPRXDIM
+41 SET RMPRDT=$PIECE(RMPRBARC,"-",2)
+42 SET RMPRBLEN=RMPRBLEN+(((5.5*($LENGTH(RMPRDT)))+35)*RMPRXDIM)
+43 ;
+44 ; Calculate bar height in dots
+45 ; this should be .15 times symbol length or .25 inches
+46 IF RMPRUNIT="MM"
Begin DoDot:1
+47 SET RMPRBHGT=((6.33325*RMPRLRES)\1)+2
+48 if RMPRBHGT<(((.15*RMPRBLEN)\1)+1)
SET RMPRBHGT=2+((.15*RMPRBLEN)\1)
+49 QUIT
End DoDot:1
+50 IF RMPRUNIT="IN"
Begin DoDot:1
+51 SET RMPRBHGT=((.25*RMPRLRES)\1)+2
+52 if RMPRBHGT<(((.15*RMPRBLEN)\1)+1)
SET RMPRBHGT=2+((.15*RMPRBLEN)\1)
+53 QUIT
End DoDot:1
+54 ;
+55 ; *** Print the symbol ***
+56 SET RMPRCRLF=$CHAR(13)_$CHAR(10)
+57 SET RMPRLCNT=0
+58 IF '$DATA(RMPR("NAME"))
IF $DATA(RMPRITXT("NAME"))
SET RMPR("NAME")=RMPRITXT("NAME")
+59 IF '$DATA(RMPR("NAME"))
IF $DATA(RMPRSTN("SITE NAME"))
SET RMPR("NAME")=RMPRSTN("SITE NAME")
+60 IF '$DATA(RMPR("NAME"))
SET RMPR("NAME")=""
ZPLIIP WRITE "^XA",RMPRCRLF
+1 WRITE "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF
+2 WRITE "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF
+3 SET RMPRLEFT=RMPRQUIZ+5
+4 SET RMPRDOWN=(RMPRQUIZ\2)-10
+5 ;
+6 ; the BAR CODE
+7 WRITE "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF
+8 SET RMPRDOWN=RMPRDOWN+((1.33*RMPRBHGT)\1)
+9 ;
+10 ; Description fields
+11 SET RMPRIND=RMPRLEFT+20
+12 SET RMPRITXT("DT")=$EXTRACT(RMPRITXT("DATE"),1,6)_$EXTRACT(RMPRITXT("DATE"),9,10)
+13 WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
+14 if RMPRLRES=12
WRITE "^AE,^FD"_$EXTRACT(RMPRITXT("ITEM")_$JUSTIFY("",12),1,12)_$EXTRACT("$ "_$JUSTIFY(RMPRITXT("UNIT PRICE"),0,2)_$JUSTIFY("",10),1,10)_" "_RMPRITXT("DT")_"^FS",RMPRCRLF
+15 if RMPRLRES=8
WRITE "^AF,^FD"_$EXTRACT(RMPRITXT("ITEM")_$JUSTIFY("",12),1,12)_$EXTRACT("$ "_$JUSTIFY(RMPRITXT("UNIT PRICE"),0,2)_$JUSTIFY("",10),1,10)_" "_RMPRITXT("DT")_"^FS",RMPRCRLF
+16 SET RMPRDOWN=RMPRDOWN+14+(RMPRQUIZ\1.5)
+17 WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
+18 if RMPRLRES=12
WRITE "^AF^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
+19 if RMPRLRES=8
WRITE "^AD^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
+20 SET RMPRDOWN=RMPRDOWN+10+(RMPRQUIZ\1.5)
+21 WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
+22 WRITE "^AF^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF
+23 SET RMPRDOWN=RMPRDOWN+8+(RMPRQUIZ\1.5)
+24 WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
+25 if RMPRLRES=12
WRITE "^AF^FD"_$EXTRACT(RMPRITXT("VENDOR"),1,18)_" # "_$EXTRACT(RMPRITXT("LOCATION"),1,18)_" # "_$EXTRACT(RMPR("NAME"),1,15)_"^FS",RMPRCRLF
+26 if RMPRLRES=8
WRITE "^AD^FD"_$EXTRACT(RMPRITXT("VENDOR"),1,18)_" # "_$EXTRACT(RMPRITXT("LOCATION"),1,18)_" # "_$EXTRACT(RMPR("NAME"),1,15)_"^FS",RMPRCRLF
+27 ;W:RMPRLRES=8 "^AD^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF
+28 ;
+29 ; finish
+30 WRITE "^XZ",RMPRCRLF
+31 SET RMPRLCNT=1+RMPRLCNT
+32 IF RMPRLCNT<RMPRNCOP
GOTO ZPLIIP
ZPLIIX QUIT
