source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVLIC.m@ 1251

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1PRCVLIC ;WOIFO/BMM - update message for 2237 line item cancel; 2/11/05 ; 3/24/05 2:50pm
2V ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7EN ;code to send update to DM notifying of canceled line item
8 ;in 2237
9 ;DA, DA(1) are defined since this code is called from a MUMPS
10 ;cross-reference
11 ;
12 ;do not process if 2237 # not cross-referenced in DynaMed IFCAP
13 ;Audit file #414.02
14 ;
15 ;FIELDS RETRIEVED:
16 ;.01 - transaction number
17 ;.5 - station number
18 ;5 - Dt requested
19 ;12 - vendor number
20 ;
21 ;OTHER DATA RETRIEVED:
22 ;DUZ - PRCVDZ
23 ;PRCVLN, PRCVFN - last name, first name from New Person (#200)
24 ;
25 Q:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
26 N PRCVA,PRCVFH,PRCVNM
27 ;create PRCVA array of header fields in 410
28 S PRCVFH=".01;.5;5;12"
29 D GETS^DIQ(410,DA(1)_",",PRCVFH,"I","PRCVA")
30 ;quit if 2237# not in 414.02
31 Q:'$D(^PRCV(414.02,"D",PRCVA(410,DA(1)_",",.01,"I")))
32 D:'$D(DT) DT^DICRW
33 ;add other data to PRCVA
34 S PRCVA(410,DA(1)_",","DT")=$$NOW^XLFDT
35 S PRCVA(410,DA(1)_",","DT7")=$$FMADD^XLFDT($$NOW^XLFDT,7,"","","")
36 S PRCVA(410,DA(1)_",","DUZ")=DUZ,PRCVNM=$$GET1^DIQ(200,DUZ_",",.01)
37 S PRCVA(410,DA(1)_",","LN")=$P(PRCVNM,",")
38 S PRCVA(410,DA(1)_",","FN")=$P(PRCVNM,",",2)
39 S PRCVA(410,DA(1)_",","DA1")=DA(1)
40 ;add PRCVA to data in job
41 M X1(9999)=PRCVA(410,DA(1)_",")
42 ;call Kernel API, job off rest
43 D OPKG^XUHUI("","PRCV 410 2237 LINE ITEM CANCEL","K","AH")
44 K X1(9999)
45 ;
46 Q
47 ;
48CREATEM ;use data from 410 and 441 to create ^XTMP structure for sending
49 ;message to DynaMed
50 ;
51 ;XUHUIX1 ARRAY SHOULD BE:
52 ;XUHUIX1(9999,.01,"I") - transaction number (file 410, field .01)
53 ;XUHUIX1(9999,.5,"I") - station number (410, 0.5)
54 ;XUHUIX1(9999,5,"I") - date requested (410, 5)
55 ;XUHUIX1(9999,12,"I") - vendor number (410, 12)
56 ;XUHUIX1(9999,"DT") - FM date now
57 ;XUHUIX1(9999,"DT7") - FM date 7 days from now
58 ;XUHUIX1(9999,"DUZ") - user DUZ
59 ;XUHUIX1(9999,"FN") - user first name
60 ;XUHUIX1(9999,"LN") - user last name
61 ;XUHUIX1(9999,"DA1") - DA(1), IEN of 2237 in 410
62 ;XUHUIX1(1) - LINE ITEM NUMBER (410.02,.01)
63 ;XUHUIX1(2) - QUANTITY (410.02,2)
64 ;XUHUIX1(3) - UNIT OF PURCHASE (410.02,3)
65 ;XUHUIX1(4) - BOC (410.02,4)
66 ;XUHUIX1(5) - ITEM MASTER FILE NO. (410.02,5)
67 ;XUHUIX1(6) - STOCK NUMBER (410.02,6)
68 ;XUHUIX1(7) - EST. ITEM (UNIT) COST (410.02,7)
69 ;XUHUIX1(8) - DM DOC ID (410.02,17)
70 ;XUHUIX1(9) - DATE NEEDED BY (410.02,18)
71 ;
72 ;other variables/data:
73 ;PRCVST - station number
74 ;PRCVNIF - NIF #
75 ;PRCVPM - packaging multiple
76 ;PRCVFV - FMS Vendor #
77 ;PRCV2237 - ^XTMP message id
78 ;PRCVNR - number of records (always 1)
79 ;
80 N PRCV2237,PRCVCT,PRCVDTD,PRCVDZ,PRCVFV,PRCVH,PRCVLI,PRCVND
81 N PRCVNR,PRCVOCC,PRCVUP,PRCVPM,PRCVST,PRCVUM
82 S PRCVH=$H,PRCVOCC="CA",PRCVNR=1,(PRCVUP,PRCVND,PRCVUM)=""
83 S (PRCVPM,PRCVFV)=0
84 S PRCVST=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
85 ;S PRCVST=XUHUIX1(9999,.5,"I")
86 ;now- line items in PRCVLI, rest in XUHUIX1
87 ;get NIF#, pkging multiple from 441
88 S PRCVITM=XUHUIX1(5),PRCVVN=XUHUIX1(9999,12,"I")
89 S PRCVNIF=$$GET1^DIQ(441,PRCVITM_",",51)
90 S PRCVPM=$$GET1^DIQ(441.01,PRCVVN_","_PRCVITM_",",1.6)
91 S PRCVFV=$$GET1^DIQ(440,PRCVVN_",",34)
92 S PRCVUP=$P($G(^PRCD(420.5,XUHUIX1(3),0)),U)
93 ;now- build ^XTMP
94 S PRCV2237="PRCVUP*"_XUHUIX1(9999,.01,"I")
95 ;0 node
96 S PRCVND=XUHUIX1(9999,"DT7")_"^"_XUHUIX1(9999,"DT")
97 K ^XTMP(PRCV2237,PRCVH)
98 S PRCVUM="^Transmit message to DynaMed for updates"
99 S ^XTMP(PRCV2237,0)=PRCVND_PRCVUM
100 S ^XTMP(PRCV2237,PRCVH,0)=PRCVND_"^Line item cancel message to DynaMed"
101 ;1 node
102 S PRCVND=PRCVNR_"^"_PRCVST_"^"_XUHUIX1(9999,"DUZ")
103 S PRCVND=PRCVND_"^"_XUHUIX1(9999,"LN")_"^"_XUHUIX1(9999,"FN")
104 S PRCVND=PRCVND_"^"_XUHUIX1(9999,"DA1")
105 S ^XTMP(PRCV2237,PRCVH,1)=PRCVND
106 ;2 node
107 S PRCVND=PRCVOCC_"^"_XUHUIX1(5)_"^"_XUHUIX1(2)
108 S PRCVND=PRCVND_"^"_XUHUIX1(9999,12,"I")_"^"_PRCVFV
109 S PRCVND=PRCVND_"^"_XUHUIX1(7)_"^"_XUHUIX1(8)_"^"_XUHUIX1(9)
110 S PRCVND=PRCVND_"^"_PRCVUP_"^"_XUHUIX1(6)_"^"_PRCVPM
111 S PRCVND=PRCVND_"^"_$P(XUHUIX1(4)," ")_"^"_PRCVNIF
112 S ^XTMP(PRCV2237,PRCVH,2,1)=PRCVND
113 ;
114 ;call Vic's code to process the data you put in ^XTMP
115 D BEGIN^PRCVEE1(PRCV2237,PRCVH)
116 ;
117 ;update Audit file
118 D UPDAUD
119 ;
120 Q
121 ;
122UPDAUD ;update the Audit file entry for this DM Doc ID
123 ;XUHUIX1(8) is DM Doc ID
124 ;adding 2237# (414.02 #7), Date/Time Removed From IFCAP
125 ;(414.02, 8), and Who Deleted (414.02, 9)
126 ;
127 ;note: the error of DM Doc ID being null won't happen here because
128 ;this code isn't called unless the protocol "PRCV 410 2237 LINE ITEM
129 ;CANCEL" fires, and that won't fire unless the cross reference on the
130 ;410.02 Line Item field fires, and that won't happen if the DM Doc ID
131 ;field of the 2237 line item being canceled is NULL.
132 ;
133 N PRCVAIEN,PRCVMSG,PRCVADR
134 S PRCVAIEN=$O(^PRCV(414.02,"B",XUHUIX1(8),0))
135 ;if no entry found in Audit file, send bulletin
136 I PRCVAIEN="" D Q
137 . S XMB(1)="canceling a line item during edit of 2237 #"
138 . S XMB(1)=XMB(1)_XUHUIX1(9999,.01,"I")
139 . S XMB(2)=XUHUIX1(8)
140 . S XMB(3)="the item is missing from the DynaMed Audit file (#414.02)"
141 . K ^TMP($J,"PRCVLIC") S PRCVTMP="PRCVLIC"
142 . S ^TMP($J,"PRCVLIC",1,0)=""
143 . S ^TMP($J,"PRCVLIC",2,0)="2237 #: "_XUHUIX1(9999,.01,"I")
144 . S ^TMP($J,"PRCVLIC",3,0)="Date/time deleted: "_XUHUIX1(9999,"DT")
145 . S ^TMP($J,"PRCVLIC",4,0)="Who deleted: "_XUHUIX1(9999,"LN")_","_XUHUIX1(9999,"FN")_" ("_XUHUIX1(9999,"DUZ")_")"
146 . S ^TMP($J,"PRCVLIC",5,0)="Item #: "_XUHUIX1(5)
147 . S PRCVFCP=$P(XUHUIX1(9999,.01,"I"),"-",4)
148 . S PRCVST=XUHUIX1(9999,.5,"I")
149 . D DMERXMB(PRCVTMP,PRCVST,PRCVFCP)
150 ;
151 N PRCVA
152 S PRCVA(414.02,PRCVAIEN_",",7)=XUHUIX1(9999,.01,"I")
153 S PRCVA(414.02,PRCVAIEN_",",8)=XUHUIX1(9999,"DT")
154 S PRCVA(414.02,PRCVAIEN_",",9)=XUHUIX1(9999,"DUZ")
155 D FILE^DIE("","PRCVA")
156 ;
157 I $D(^TMP("DIERR",$J)) D Q
158 . S XMB(1)="canceling a line item during edit of 2237 #"
159 . S XMB(1)=XMB(1)_XUHUIX1(9999,.01,"I")
160 . S XMB(2)=XUHUIX1(8)
161 . S XMB(3)="error while updating DynaMed Audit file (#414.02)"
162 . K ^TMP($J,"PRCVLIC") S PRCVTMP="PRCVLIC"
163 . S ^TMP($J,"PRCVLIC",1,0)=""
164 . S ^TMP($J,"PRCVLIC",2,0)="2237 #: "_XUHUIX1(9999,.01,"I")
165 . S ^TMP($J,"PRCVLIC",3,0)="Item #: "_XUHUIX1(5)
166 . S ^TMP($J,"PRCVLIC",4,0)="Date/time deleted: "_XUHUIX1(9999,"DT")
167 . S ^TMP($J,"PRCVLIC",5,0)="Who deleted: "_XUHUIX1(9999,"LN")_","_XUHUIX1(9999,"FN")_" ("_XUHUIX1(9999,"DUZ")_")"
168 . S ^TMP($J,"PRCVLIC",6,0)="Error text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
169 . S PRCVFCP=$P(XUHUIX1(9999,.01,"I"),"-",4)
170 . S PRCVST=XUHUIX1(9999,.5,"I")
171 . D DMERXMB(PRCVTMP,PRCVST,PRCVFCP)
172 Q
173 ;
174DMERXMB(PRCVTMP,PRCVST,PRCVFCP) ;create a bulletin to send to FCP users
175 ;notifying of line item missing a DM Doc ID value or error
176 ;updating the Audit file.
177 ;
178 ;the bulletin has these variable components:
179 ;XMB - bulletin name (PRCV_AUDIT_FILE_ERROR)
180 ;XMB(1) - action/event/identifier ex. "line item cancel during edit
181 ; of 2237 #516-05-2-076-0445"
182 ;XMB(2) - DM Doc ID value
183 ;XMB(3) - error reason, either "an error updating the Audit file" or
184 ; "the item was missing its DynaMed Doc ID value"
185 ;XMTEXT - overflow global in ^TMP, contains values that would've
186 ; been added to Audit file had error not occurred
187 ;XMSUB - set in Bulletin file, "ERROR UPDATING DYNAMED AUDIT FILE"
188 ;XMY - array of FCP users to receive bulletin, built in GETFCPU
189 ;XMDUZ - new value ensures bulletin is seen by user as new mail
190 ;
191 ;input parameters
192 ;PRCVTMP - suscript for ^TMP array in bulletin
193 ;PRCVFCP - fund control point
194 ;PRCVST - station number
195 ;
196 N XMY,XMDUZ
197 I $G(PRCVTMP)'="" S XMTEXT="^TMP($J,"""_PRCVTMP_""","
198 S XMB="PRCV_AUDIT_FILE_ERROR"
199 S XMDUZ="DOCUMENT PROCESSOR"
200 ;D GETFCPU(.XMY,PRCVST,PRCVFCP)
201 ;send to special mail group
202 S XMY("G.PRCV Audit File Alerts")=""
203 D ^XMB
204 Q
205 ;
206GETFCPU(PRCVXMY,PRCVST,PRCVFCP) ;retrieve all the FCP users who are Control
207 ;Point Officials or Control Point Clerks and are enabled to
208 ;receive the bulletin
209 ;PRCVFCP is fund control point
210 ;PRCVST is station number
211 ;
212 N A,I,PRCVX K PRCVXMY
213 S PRCVX="",PRCVFCP=+PRCVFCP
214 F I=0:0 S PRCVX=$O(^PRC(420,PRCVST,1,PRCVFCP,1,PRCVX)) Q:PRCVX="" D
215 . S A=$G(^(PRCVX,0))
216 . I $P(A,U,3)="Y",($P(A,U,2)=1!($P(A,U,2)=2)) S PRCVXMY(PRCVX)=""
217 ;S (PRCVXMY(36002),PRCVXMY(35994),PRCVXMY(35993))=""
218 Q
219 ;
220CHKDM(PRCVSUB) ;function that checks if the given value in PRCVSUB
221 ;is in the Audit file index passed in PRCVIND.
222 ;1=yes, 0=no
223 ;
224 N PRCVP2,PRCVPC,PRCVPI,PRCVVAL
225 S (PRCVPI,PRCVP2,PRCVVAL)=0
226D1 I $D(^PRCV(414.02,"D",PRCVSUB)) S PRCVVAL=1 G EX
227 ;not there, check for child
228 S PRCVPI=$O(^PRCS(410,"B",PRCVSUB,0))
229 I +PRCVPI=0 G EX
230 S PRCVPC=$P($G(^PRCS(410,PRCVPI,10)),U,2)
231 I +PRCVPC=0 G EX
232 S PRCVSUB=PRCVPC G D1
233EX Q PRCVVAL
234 ;
Note: See TracBrowser for help on using the repository browser.