source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYZ.m@ 1688

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

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1RMPRPIYZ ;HINES CIO/ODJ - Bar Code Print all label ;10/8/02 13:11
2 ;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996
3 Q
4 ;
5PB ;***** PB - Print ALL Bar Code labels
6 ;
7 ;
8 ;***** STN - prompt for Site/Station
9STN ;S RMPROVAL=$G(RMPRSTN("IEN"))
10 W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
11 I RMPRERR G PBX
12 I RMPREXC'="" G PBX
13 S RS=RMPRSTN("IEN") K RMPR1,RMPR11
14 ;
15LOC ; askk for location
16 ;
17 S RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
18 I RMPREXC="T"!(RMPREXC="^") G PBX
19 I RMPREXC="P" G STN
20 S RL=RMPR5("IEN") K RMPR1
21 ;
22 ;***** PRINT - print bar code labels
23 ; requires RMPRNLAB (number of labels) and
24 ; RMPRBCP (bar code printer name) to be set
25 ; RMPRBARC (bar code to print)
26 ; RMPRIOP (the device to open)
27PRINT ;I '$D(RMPRBCP) G PRINTX
28 ;allows queing of bar code labels
29SELD S %ZIS("A")="Select Bar Code Printer: "
30 S %ZIS="QM" K IOP W ! D ^%ZIS G:POP PRINTX
31 I $G(IOST)'["P-ZEBRA" D
32 . W !!,"** WARNING - This is NOT a Zebra Bar Code Printer!!",!!
33 I '$D(IO("Q")) U IO G PNOW
34 K IO("Q") S ZTDESC="PRINT BAR CODE LABELS",ZTRTN="PNOW^RMPRPIYZ"
35 S ZTIO=ION,ZTSAVE("RS")="",ZTSAVE("RL")=""
36 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 G PRINTC
37 ;
38PNOW ;jump here if not queued.
39 ;
40 ;
41LOOP ;loop 661.7 for all items in a location.
42 F RI=0:0 S RI=$O(^RMPR(661.7,"C",RL,RI)) Q:RI'>0 S RMDAT=$G(^RMPR(661.7,RI,0)) S RMSTN=$P(RMDAT,U,5) I RMSTN=RS D PROC
43 ;exit/done printing bar code labels
44 G PRINTC
45 ;
46PROC ;process bar code for printing.
47 S (RMPRNLAB,RME)=0,RMPR11("DESCRIPTION")=""
48 S RMPR6("VENDOR")="",RMLOCNA=""
49 K RMPR7I,RM441,RM661
50 S RMPR7("IEN")=RI,RMPR7("HCPCS")=$P(RMDAT,U,1)
51 S RMPR7("ITEM")=$P(RMDAT,U,4),RH=$P(RMDAT,U,1)
52 S RD=$P(RMDAT,U,2)
53 S (RMPR7("LOCATION"),RMLOC)=$P(RMDAT,U,6)
54 S RMPR7("VALUE")=$P(RMDAT,U,8),RMPR7("QUANTITY")=$P(RMDAT,U,7)
55 I $G(RMLOC),$D(^RMPR(661.5,RMLOC,0)) D
56 .S RMLOCNA=$P(^RMPR(661.5,RMLOC,0),U,1)
57 ;
58ITEM ;get 661.11 record
59 S RMPR11("IEN")=$O(^RMPR(661.11,"ASHI",RS,RH,RMPR7("ITEM"),0))
60 S RME=$$GET^RMPRPIX1(.RMPR11)
61 I RME=1 Q
62 ;
63VEND ;get vendor from 661.6.
64 S RMV="",RMPR6("VENDOR")="",RMPR11("ITEM MSTER")=""
65 F K=0:0 S K=$O(^RMPR(661.6,"C",RD,K)) Q:K'>0 S RM6=$G(^RMPR(661.6,K,0)) D
66 .Q:RH'=$P(RM6,U,1)
67 .I (RH=$P(RM6,U,1)),(RMLOC=$P(RM6,U,14)) S RMV=$P(RM6,U,12)
68 .S:$G(RMV) RMPR6("VENDOR")=$$GETVEN^RMPRPIU0(RMV)
69 ;
70 ;external format of items at #661.7
71 S RME=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
72 I RME=1 Q
73 ;
74 ;set variables for printing bar code.
75 S RMPRBARC=RMPR7I("HCPCS")_"-"_$P(RMPR7I("DATE&TIME"),".",1)_$P(RMPR7I("DATE&TIME"),".",2)
76 S RMPRITXT("DATE")=$E(RMPR7I("DATE&TIME"),4,5)_"/"_$E(RMPR7I("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR7I("DATE&TIME"),1,3))
77 S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
78 S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
79 S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
80 S RMPRITXT("UNIT PRICE")=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,2)
81 S RMPRITXT("VENDOR")=RMPR6("VENDOR")
82 S RMPRITXT("LOCATION")=RMLOCNA
83 S RMPRNLAB=RMPR7("QUANTITY")
84 ;call bar code routine
85 D ZPLII^RMPRPI11(RMPRBARC,.RMPRITXT,RMPRNLAB)
86 Q
87 ;
88PRINTC ;
89 D ^%ZISC K IONOFF
90 ;
91PBX D KILL^XUSCLEAN
92PRINTX Q
Note: See TracBrowser for help on using the repository browser.