source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXJ.m@ 1476

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

initial load of WorldVistAEHR
File size: 6.4 KB
Line 
1RMPRPIXJ ;HIN/RVD - INVENTORY UTILITY UPDATE BALANCE ;2/13/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 W !,"***Invalid Entry!!!!" Q
5 ;
6SVAL(RX) ;STARTING total Value.
7 ;The Starting total Value is the Total Value of the previous entry
8 ;date specified. If no previous entry, the Total Value will
9 ;be set to ZERO.
10 ;
11 ;pass variable station, hcpcs, hcpcs item and date in RX local array.
12 ; RX("STA") = station
13 ; RX("HCP") = HCPCS
14 ; RX("ITE") = HCPCS item
15 ; RX("RDT") = date (starting date)
16 ; REBAL = return variable (Starting Total Value based on the date)
17 N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
18 S REBAL=0
19 S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
20 Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
21 S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
22 I '$G(RDATE) Q REBAL
23 S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
24 S RDATA=$G(^RMPR(661.9,RI,0))
25 S REBAL=$P(RDATA,U,9)
26 Q REBAL
27 ;
28 ;
29CVAL(RX) ;CURRENT total Value
30 ;The Current total Value is the total value based on the date specified.
31 ;If the Date specified has no entry, the Current Total Value will be
32 ;extracted from the previous date entry. If it has no previous entry,
33 ;the Current Total Value will be set to ZERO.
34 ;
35 ;pass variable station, hcpcs, hcpcs item and date in RX local array.
36 ; RX("STA") = station
37 ; RX("HCP") = HCPCS
38 ; RX("ITE") = HCPCS item
39 ; RX("RDT") = date (current date)
40 ; REBAL = return variable (Current Total value based on the date)
41 N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
42 S REBAL=0
43 S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
44 Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
45 S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0))
46 I '$G(RI) D I '$G(RI) Q REBAL
47 .S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
48 .S:$G(RDATE) RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
49 S RDATA=$G(^RMPR(661.9,RI,0))
50 S REBAL=$P(RDATA,U,9)
51 Q REBAL
52 ;
53 ;
54SQTY(RX) ;STARTING total Quantity.
55 ;The Starting total Quantity is the Total qty of the previous entry
56 ;date specified. If no previous entry, the Total qty will
57 ;be set to ZERO.
58 ;
59 ;pass variable station, hcpcs, hcpcs item and date in RX local array.
60 ; RX("STA") = station
61 ; RX("HCP") = HCPCS
62 ; RX("ITE") = HCPCS item
63 ; RX("RDT") = date (starting date)
64 ; REBAL = return variable (Starting Total qty based on the date)
65 N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
66 S REBAL=0
67 S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
68 Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
69 S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
70 I '$G(RDATE) Q REBAL
71 S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
72 S RDATA=$G(^RMPR(661.9,RI,0))
73 S REBAL=$P(RDATA,U,8)
74 Q REBAL
75 ;
76 ;
77CQTY(RX) ;CURRENT total QTY
78 ;The Current total qty is the total qty based on the date specified.
79 ;If the Date specified has no entry, the Current Total qty will be
80 ;extracted from the previous date entry. If it has no previous entry,
81 ;the Current Total qty will be set to ZERO.
82 ;
83 ;pass variable station, hcpcs, hcpcs item and date in RX local array.
84 ; RX("STA") = station
85 ; RX("HCP") = HCPCS
86 ; RX("ITE") = HCPCS item
87 ; RX("RDT") = date (current date)
88 ; REBAL = return variable (Current Total qty based on the date)
89 N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
90 S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
91 Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
92 S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0))
93 I '$G(RI) D I '$G(RI) Q REBAL
94 .S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
95 .S:$G(RDATE) RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
96 S RDATA=$G(^RMPR(661.9,RI,0))
97 S REBAL=$P(RDATA,U,8)
98 Q REBAL
99 ;
100TVAQT ;get total qty and cost from 661.7
101 N R7I,R7J,R7DAT,R7QBAL,R7CBAL
102 S (RMPRQBAL,RMPRCBAL)=0
103 F R7I=0:0 S R7I=$O(^RMPR(661.7,"XSHIDS",RS,RH,RM,R7I)) Q:R7I'>0 F R7J=0:0 S R7J=$O(^RMPR(661.7,"XSHIDS",RS,RH,RM,R7I,1,R7J)) Q:R7J'>0 D
104 .S R7DAT=$G(^RMPR(661.7,R7J,0))
105 .S R7QBAL=$P(R7DAT,U,7)
106 .S R7CBAL=$P(R7DAT,U,8)
107 .I $G(R7QBAL) S RMPRQBAL=RMPRQBAL+R7QBAL
108 .I $G(R7CBAL) S RMPRCBAL=RMPRCBAL+R7CBAL
109 Q
110 ;
111UPCR(RX) ;UPDATE or CREATE entry in 661.9
112 ;If an entry already exist, this subroutine will update the entry.
113 ;If no entry exist, this subroutine will create an entry.
114 ;The calling routine should check if $G(RMERROR), then error occured.
115 ;
116 ;pass variable station, hcpcs, hcpcs item, date, total quantity
117 ;and total cost in RX local array.
118 ; RX("STA") = station
119 ; RX("HCP") = HCPCS
120 ; RX("ITE") = HCPCS item
121 ; RX("RDT") = date
122 ; RX("TQTY")= net quantity to add to balance
123 ; RX("TCST")= net cost to add to balance
124 N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
125 N RMPRCBAL,RMPRQBAL
126 S RMERROR=0
127 S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
128 S RQ=RX("TQTY"),RC=$J(RX("TCST"),0,2)
129 I (RS="")!(RH="")!(RD="") S RMERROR=1 Q RMERROR
130 S (RMPRQBAL,RMPRCBAL)="" ;init quantity and cost balances
131 L +^RMPR(661.9,"ASHID",RS,RH,RM)
132UPCRA K RI,RMDAT,RMERR,RDATA
133 ;get the current total quntity and cost from 661.7.
134 D TVAQT
135 S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0))
136 ;if there is an entry, update totals: (balance & cost).
137 I $G(RI) D
138 .S RDATA=$G(^RMPR(661.9,RI,0))
139 .;S RMPRQBAL=$P(RDATA,U,8)
140 .;S RMPRCBAL=$P(RDATA,U,9)
141 .S RMDAT(661.9,RI_",",.01)=RD
142 .S RMDAT(661.9,RI_",",1)=RH
143 .S RMDAT(661.9,RI_",",2)=RM
144 .S RMDAT(661.9,RI_",",4)=RS
145 .S RMDAT(661.9,RI_",",7)=RMPRQBAL
146 .S RMDAT(661.9,RI_",",8)=RMPRCBAL
147 .D FILE^DIE("K","RMDAT","RMERR")
148 .I $D(RMERR) S RMERROR=1
149 ;if no entry, create an entry for the date being passed.
150 E D
151 .S RX("RDT")=RD
152 .S RMDAT(661.9,"+1,",.01)=RD
153 .S RMDAT(661.9,"+1,",1)=RH
154 .S RMDAT(661.9,"+1,",2)=RM
155 .S RMDAT(661.9,"+1,",4)=RS
156 .S RMDAT(661.9,"+1,",7)=RMPRQBAL
157 .S RMDAT(661.9,"+1,",8)=RMPRCBAL
158 .D UPDATE^DIE("","RMDAT","RI","RMERR")
159 .I $D(RMERR) S RMERROR=1
160 I RMERROR G UPCRU
161 ;
162 ; Get next date and continue update so that all subsequent
163 ; balances are correct
164UPCRN S RD=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD))
165 I RD'="" G UPCRA
166UPCRU L -^RMPR(661.9,"ASHID",RS,RH,RM)
167UPCRX Q RMERROR
168 ;
169ALLREC(RMA) ;reconcile all HCPCS in 661.9
170 Q:RMA'="TEST"
171 N RM11,RM11DAT,RX
172 S U="^",RMERR=0
173 S RX("TQTY")=0
174 S RX("TCST")=0
175 S RX("RDT")=DT
176 F RM11=0:0 S RM11=$O(^RMPR(661.11,RM11)) Q:RM11'>0 D
177 .S RM11DAT=^RMPR(661.11,RM11,0)
178 .S RX("HCP")=$P(RM11DAT,U,1)
179 .S RX("ITE")=$P(RM11DAT,U,2)
180 .S RX("STA")=$P(RM11DAT,U,4)
181 .W !,RX("HCP")," ",RX("ITE")," ",RX("STA")
182 .S RMERR=$$UPCR^RMPRPIXJ(.RX)
183 Q RMERR
184 ;
185NVAR ;new all variables
186 N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
187 N RMPRCBAL,RMPRQBAL
188 Q
Note: See TracBrowser for help on using the repository browser.