- 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 Feb 19, 2025@00:02:32 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