source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXN.m@ 896

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1RMPRPIXN ;HINCIO/ODJ - PIP STOCK ORDERS 661.41 file APIs ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** GET - read in a HCPCS Item order record (661.41)
6 ;
7 ; Inputs:
8 ; RMPR41 - array of order data fields...
9 ; RMPR41("IEN") - ien of 661.41 record being read
10 ;
11 ; Outputs:
12 ; RMPR11 - HCPCS Item array
13 ; RMPR11("STATION") - Station name
14 ; RMPR11("HCPCS") - HCPCS code
15 ; RMPR11("ITEM") - HCPCS Item
16 ;
17 ; RMPR41 - Order data fields array
18 ; RMPR41("DATE ORDER") - Order date (external)
19 ; RMPR41("VENDOR") - Vendor name
20 ; RMPR41("DATE RECEIVE") - Date of last receipt against the order
21 ; (external)
22 ; RMPR41("ORDER QTY") - Quantity ordered
23 ; RMPR41("RECEIVE QTY") - Quantity received against the order
24 ; RMPR41("COMMENT") - optional comment
25 ; RMPR41("BALANCE QTY") - Balance quantity still on order
26 ; RMPR41("STATUS") - Status (external)
27 ;
28 ; RMPRERR - error status returned by function
29 ; 0 - no problems
30 ; 1 - invalid RMPR41("IEN") entered
31 ; 2 - Problem with FM call
32 ;
33GET(RMPR41,RMPR11) ;
34 N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
35 S RMPRERR=0
36 I $G(RMPR41("IEN"))="" S RMPRERR=1 G GETX
37 S RMPRIEN=RMPR41("IEN")_","
38 D GETS^DIQ(661.41,RMPRIEN,"*","","RMPROUP","RMPRFME")
39 I $D(RMPRFME) S RMPRERR=2 G GETX
40 S RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2)
41 S RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5)
42 S RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1)
43 S RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4)
44 S RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01)
45 S RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6)
46 S RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7)
47 S RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8)
48 S RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9)
49 S RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY")
50 S RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10)
51GETX Q RMPRERR
52 ;
53 ;***** GETI - get internal form of Order data fields
54 ;
55 ; Inputs and Outputs same as above for GET, except all internal values
56 ; ie pointer's not names, internal not display date formats, etc.
57 ;
58GETI(RMPR41,RMPR11) ;
59 N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
60 S RMPRERR=0
61 I $G(RMPR41("IEN"))="" S RMPRERR=1 G GETX
62 S RMPRIEN=RMPR41("IEN")_","
63 D GETS^DIQ(661.41,RMPRIEN,"*","I","RMPROUP","RMPRFME")
64 I $D(RMPRFME) S RMPRERR=2 G GETX
65 S RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2,"I")
66 S RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5,"I")
67 S RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1,"I")
68 S RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4,"I")
69 S RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01,"I")
70 S RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6,"I")
71 S RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7,"I")
72 S RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8,"I")
73 S RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9,"I")
74 S RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY")
75 S RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10,"I")
76GETIX Q RMPRERR
77 ;
78 ;***** UPD - Update an existing Order 661.41 record
79 ;
80 ; Inputs/Outputs - see above
81 ; See GETI above for structure of RMPR41 and RMPR11 input arrays
82 ; values must be in internal form
83 ;
84UPD(RMPR41,RMPR11) ;
85 N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
86 S RMPRERR=0
87 I $G(RMPR41("IEN"))="" S RMPRERR=1 G UPDX
88 S RMPRIEN=RMPR41("IEN")_","
89 S:$D(RMPR11("STATION")) RMPROUP(661.41,RMPRIEN,2)=RMPR11("STATION")
90 S:$D(RMPR11("HCPCS")) RMPROUP(661.41,RMPRIEN,5)=RMPR11("HCPCS")
91 S:$D(RMPR11("ITEM")) RMPROUP(661.41,RMPRIEN,1)=RMPR11("ITEM")
92 S:$D(RMPR41("DATE ORDER")) RMPROUP(661.41,RMPRIEN,.01)=RMPR41("DATE ORDER")
93 S:$D(RMPR41("DATE RECEIVE")) RMPROUP(661.41,RMPRIEN,6)=RMPR41("DATE RECEIVE")
94 S:$D(RMPR41("VENDOR")) RMPROUP(661.41,RMPRIEN,4)=RMPR41("VENDOR")
95 S:$D(RMPR41("ORDER QTY")) RMPROUP(661.41,RMPRIEN,7)=RMPR41("ORDER QTY")
96 S:$D(RMPR41("RECEIVE QTY")) RMPROUP(661.41,RMPRIEN,8)=RMPR41("RECEIVE QTY")
97 S:$D(RMPR41("COMMENT")) RMPROUP(661.41,RMPRIEN,9)=RMPR41("COMMENT")
98 S:$D(RMPR41("STATUS")) RMPROUP(661.41,RMPRIEN,10)=RMPR41("STATUS")
99 D:$D(RMPROUP) FILE^DIE("","RMPROUP","RMPRFME")
100 I $D(RMPRFME) S RMPRERR=2
101UPDX Q RMPRERR
102 ;
103 ;***** CRE - Create an Order 661.41 record
104 ;
105 ; Inputs/Outputs - see above
106 ; See GETI above for structure of RMPR41 and RMPR11 input arrays
107 ; values must be in internal form
108 ;
109CRE(RMPR41,RMPR11) ;
110 N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
111 S RMPRERR=0
112 S RMPROUP(661.41,"+1,",2)=RMPR11("STATION")
113 S RMPROUP(661.41,"+1,",5)=RMPR11("HCPCS")
114 S RMPROUP(661.41,"+1,",1)=RMPR11("ITEM")
115 S:$D(RMPR41("DATE ORDER")) RMPROUP(661.41,"+1,",.01)=RMPR41("DATE ORDER")
116 S:$D(RMPR41("DATE RECEIVE")) RMPROUP(661.41,"+1,",6)=RMPR41("DATE RECEIVE")
117 S:$D(RMPR41("VENDOR")) RMPROUP(661.41,"+1,",4)=RMPR41("VENDOR")
118 S:$D(RMPR41("ORDER QTY")) RMPROUP(661.41,"+1,",7)=RMPR41("ORDER QTY")
119 S:$D(RMPR41("RECEIVE QTY")) RMPROUP(661.41,"+1,",8)=RMPR41("RECEIVE QTY")
120 S RMPROUP(661.41,"+1,",9)=$G(RMPR41("COMMENT"))
121 S RMPROUP(661.41,"+1,",10)=RMPR41("STATUS")
122 D UPDATE^DIE("","RMPROUP","RMPRIEN","RMPRFME")
123 I $D(RMPRFME) S RMPRERR=1
124 S RMPR41("IEN")=RMPRIEN(1)
125CREX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.