Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPI11

RMPRPI11.m

Go to the documentation of this file.
  1. RMPRPI11 ;HIN/ODJ-PRINT BAR CODE LABELS ;10/8/02 13:11
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. ;
  1. Q
  1. ;
  1. ;***** SELP - Prompt for Bar Code printer
  1. SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ;
  1. N POP
  1. START S %ZIS("A")="Select Bar Code Printer: "
  1. S %ZIS("B")=""
  1. S %ZIS="QN" K IOP
  1. D ^%ZIS
  1. S RMPRQ=0
  1. S RMPREXC=""
  1. I POP S RMPREXC="P" G SELPX
  1. I '$D(IO("Q")) D G SELPX
  1. . S RMPRBCP=$G(IOST)
  1. . S:RMPRBCP="" RMPREXC="^"
  1. . S RMPRIOP=$G(ION)
  1. . Q
  1. ;I '$D(IO("Q")) U IO D TEST G SELPX
  1. ;K IO("Q") S ZTDESC="SLAVE PRINT TEST"
  1. ;S ZTRTN="TEST^RMPRPI11",ZTIO=ION
  1. ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX
  1. SELPX Q
  1. TEST S IOP=ION,%ZIS="" D ^%ZIS
  1. W !!,"TESTING SLAVE DEVICE",!!
  1. W @IOF
  1. D ^%ZISC
  1. Q
  1. ;
  1. ; Print bar code for printer using ZPLII command set (ZEBRAS)
  1. ; applies to Z4000 and all Zebra printers.
  1. ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ;
  1. N RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRMMIN
  1. N RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF
  1. N RMPRLEFT,RMPRDOWN,RMPRLCNT
  1. S RMPRUNIT="MM" ; use mm units
  1. S RMPRLTYP="" ; <not used yet>
  1. S RMPRLWID=75 ; Lable width 75mm
  1. S RMPRLHGT=25 ; Label height 25mm
  1. ;if printer resolution not defined in terminal type file,
  1. ;default to 8 dpm
  1. I '$G(RMPRLRES) S RMPRLRES=8 ; 8 for 203dpi & 12 for 300dpi
  1. S RMPRMMIN=25.333 ; mm to the inch conversion factor
  1. I '+$G(RMPRNCOP) S RMPRNCOP=1
  1. ;
  1. ; Set the X dimension in dots (width of narrow bar)
  1. ; minimum recommended X dimension is .25mm (7.5/1000th inch)
  1. I RMPRUNIT="MM" D
  1. . S RMPRXDIM=RMPRLRES*.25
  1. . Q
  1. I RMPRUNIT="IN" D
  1. . S RMPRXDIM=RMPRLRES*.0075
  1. . Q
  1. S:RMPRXDIM'=(RMPRXDIM\1) RMPRXDIM=.5+(RMPRXDIM\1)
  1. ;
  1. ; Calculate the quiet zone in dots
  1. ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch)
  1. I RMPRUNIT="MM" D
  1. . S RMPRQUIZ=((2.5333*RMPRLRES)\1)+1
  1. . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM
  1. . Q
  1. I RMPRUNIT="IN" D
  1. . S RMPRQUIZ=((.1*RMPRLRES)\1)+1
  1. . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM
  1. . Q
  1. ;
  1. ; Calculate length (in dots) of symbol to be printed
  1. ; Symbol is [HCPCS code][-][Date and Time]
  1. ; [HCPCS code] and [-] will be alphanumeric
  1. ; [Date and Time] will be numeric using code C
  1. S RMPRHCPC=$P(RMPRBARC,"-",1)
  1. S RMPRBLEN=((11*($L(RMPRHCPC)+5))+35)*RMPRXDIM
  1. S RMPRDT=$P(RMPRBARC,"-",2)
  1. S RMPRBLEN=RMPRBLEN+(((5.5*($L(RMPRDT)))+35)*RMPRXDIM)
  1. ;
  1. ; Calculate bar height in dots
  1. ; this should be .15 times symbol length or .25 inches
  1. I RMPRUNIT="MM" D
  1. . S RMPRBHGT=((6.33325*RMPRLRES)\1)+2
  1. . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=2+((.15*RMPRBLEN)\1)
  1. . Q
  1. I RMPRUNIT="IN" D
  1. . S RMPRBHGT=((.25*RMPRLRES)\1)+2
  1. . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=2+((.15*RMPRBLEN)\1)
  1. . Q
  1. ;
  1. ; *** Print the symbol ***
  1. S RMPRCRLF=$C(13)_$C(10)
  1. S RMPRLCNT=0
  1. I '$D(RMPR("NAME")),$D(RMPRITXT("NAME")) S RMPR("NAME")=RMPRITXT("NAME")
  1. I '$D(RMPR("NAME")),$D(RMPRSTN("SITE NAME")) S RMPR("NAME")=RMPRSTN("SITE NAME")
  1. I '$D(RMPR("NAME")) S RMPR("NAME")=""
  1. ZPLIIP W "^XA",RMPRCRLF
  1. W "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF
  1. W "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF
  1. S RMPRLEFT=RMPRQUIZ+5
  1. S RMPRDOWN=(RMPRQUIZ\2)-10
  1. ;
  1. ; the BAR CODE
  1. W "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF
  1. S RMPRDOWN=RMPRDOWN+((1.33*RMPRBHGT)\1)
  1. ;
  1. ; Description fields
  1. S RMPRIND=RMPRLEFT+20
  1. S RMPRITXT("DT")=$E(RMPRITXT("DATE"),1,6)_$E(RMPRITXT("DATE"),9,10)
  1. W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
  1. 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
  1. 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
  1. S RMPRDOWN=RMPRDOWN+14+(RMPRQUIZ\1.5)
  1. W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
  1. W:RMPRLRES=12 "^AF^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
  1. W:RMPRLRES=8 "^AD^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
  1. S RMPRDOWN=RMPRDOWN+10+(RMPRQUIZ\1.5)
  1. W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
  1. W "^AF^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF
  1. S RMPRDOWN=RMPRDOWN+8+(RMPRQUIZ\1.5)
  1. W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
  1. W:RMPRLRES=12 "^AF^FD"_$E(RMPRITXT("VENDOR"),1,18)_" # "_$E(RMPRITXT("LOCATION"),1,18)_" # "_$E(RMPR("NAME"),1,15)_"^FS",RMPRCRLF
  1. W:RMPRLRES=8 "^AD^FD"_$E(RMPRITXT("VENDOR"),1,18)_" # "_$E(RMPRITXT("LOCATION"),1,18)_" # "_$E(RMPR("NAME"),1,15)_"^FS",RMPRCRLF
  1. ;W:RMPRLRES=8 "^AD^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF
  1. ;
  1. ; finish
  1. W "^XZ",RMPRCRLF
  1. S RMPRLCNT=1+RMPRLCNT
  1. I RMPRLCNT<RMPRNCOP G ZPLIIP
  1. ZPLIIX Q