source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI13.m@ 1389

Last change on this file since 1389 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1RMPRPI13 ;HIN/ODJ-PRINT BAR CODE LABELS ;2/09/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 ;
4 Q
5 ;
6 ;***** SELP - Prompt for Bar Code printer
7SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ;
8 N POP
9 S %ZIS("A")="Select Bar Code Printer: "
10 S %ZIS("B")=""
11 S %ZIS="QN" K IOP
12 D ^%ZIS
13 S RMPRQ=0
14 S RMPREXC=""
15 I POP S RMPREXC="P" G SELPX
16 I '$D(IO("Q")) D G SELPX
17 . S RMPRBCP=$G(IOST)
18 . S:RMPRBCP="" RMPREXC="^"
19 . S RMPRIOP=$G(ION)
20 . Q
21 ;I '$D(IO("Q")) U IO D TEST G SELPX
22 ;K IO("Q") S ZTDESC="SLAVE PRINT TEST"
23 ;S ZTRTN="TEST^RMPRPI11",ZTIO=ION
24 ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX
25SELPX Q
26TEST S IOP=ION,%ZIS="" D ^%ZIS
27 W !!,"TESTING SLAVE DEVICE",!!
28 W @IOF
29 D ^%ZISC
30 Q
31 ;
32 ; Print bar code for printer using ZPLII command set (ZEBRAS)
33 ; applies to S600
34ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ;
35 N RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRLRES,RMPRMMIN
36 N RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF
37 N RMPRLEFT,RMPRDOWN,RMPRLCNT
38 S RMPRUNIT="MM" ; use mm units
39 S RMPRLTYP="" ; <not used yet>
40 S RMPRLWID=75 ; Lable width 75mm
41 S RMPRLHGT=25 ; Label height 25mm
42 S RMPRLRES=8 ; 8 dots/mm resolution
43 S RMPRMMIN=25.333 ; mm to the inch conversion factor
44 I '+$G(RMPRNCOP) S RMPRNCOP=1
45 ;
46 ; Set the X dimension in dots (width of narrow bar)
47 ; minimum recommended X dimension is .19mm (7.5/1000th inch)
48 I RMPRUNIT="MM" D
49 . S RMPRXDIM=RMPRLRES*.19
50 . Q
51 I RMPRUNIT="IN" D
52 . S RMPRXDIM=RMPRLRES*.0075
53 . Q
54 S:RMPRXDIM'=(RMPRXDIM\1) RMPRXDIM=1+(RMPRXDIM\1)
55 ;
56 ; Calculate the quiet zone in dots
57 ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch)
58 I RMPRUNIT="MM" D
59 . S RMPRQUIZ=((2.5333*RMPRLRES)\1)+1
60 . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM
61 . Q
62 I RMPRUNIT="IN" D
63 . S RMPRQUIZ=((.1*RMPRLRES)\1)+1
64 . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM
65 . Q
66 ;
67 ; Calculate length (in dots) of symbol to be printed
68 ; Symbol is [HCPCS code][-][Date and Time]
69 ; [HCPCS code] and [-] will be alphanumeric
70 ; [Date and Time] will be numeric using code C
71 S RMPRHCPC=$P(RMPRBARC,"-",1)
72 S RMPRBLEN=((11*($L(RMPRHCPC)+5))+35)*RMPRXDIM
73 S RMPRDT=$P(RMPRBARC,"-",2)
74 S RMPRBLEN=RMPRBLEN+(((5.5*($L(RMPRDT)))+35)*RMPRXDIM)
75 ;
76 ; Calculate bar height in dots
77 ; this should be .15 times symbol length or .25 inches
78 I RMPRUNIT="MM" D
79 . S RMPRBHGT=((6.33325*RMPRLRES)\1)+1
80 . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=1+((.15*RMPRBLEN)\1)
81 . Q
82 I RMPRUNIT="IN" D
83 . S RMPRBHGT=((.25*RMPRLRES)\1)+1
84 . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=1+((.15*RMPRBLEN)\1)
85 . Q
86 ;
87 ; *** Print the symbol ***
88 S RMPRCRLF=$C(13)_$C(10)
89 S RMPRLCNT=0
90ZPLIIP W "^XA",RMPRCRLF
91 W "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF
92 W "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF
93 S RMPRLEFT=RMPRQUIZ
94 S RMPRDOWN=RMPRQUIZ\2
95 ;
96 ; the BAR CODE
97 W "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF
98 S RMPRDOWN=RMPRDOWN+((1.4*RMPRBHGT)\1)
99 ;
100 ; Description fields
101 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
102 W "^AC^FD"_$E(RMPRITXT("ITEM")_$J("",15),1,15)_$E("$ "_RMPRITXT("UNIT PRICE")_$J("",15),1,15)_RMPRITXT("DATE")_"^FS",RMPRCRLF
103 S RMPRDOWN=RMPRDOWN+1+RMPRQUIZ
104 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
105 W "^AB^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF
106 S RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5)
107 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
108 W "^AB^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF
109 S RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5)
110 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF
111 W "^AB^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF
112 ;
113 ; finish
114 W "^XZ",RMPRCRLF
115 S RMPRLCNT=1+RMPRLCNT
116 I RMPRLCNT<RMPRNCOP G ZPLIIP
117ZPLIIX Q
Note: See TracBrowser for help on using the repository browser.