source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCV442B.m@ 763

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1PRCV442B ;WOIFO/CC-GET DATA WHEN ITEM DELETED, SET UP AUDIT FILE;1/29/05
2V ;;5.1;IFCAP;**81,86**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6RRAUD(POIEN,PRCV,PRCVCR,PRCVDAT) ; add deleted Receiving Report to audit file
7 ;
8 ; POIEN = the ien of the purchase order from which the receiving
9 ; report is being deleted.
10 ; PRCV = the string of info about the item (from PRCV442A)
11 ; DM DOC ID ^ Item ien ^ line item # ^ 2237 ien ^ UOP ^
12 ; qty ordered ^ unit price ^ NIF ^ pkg mult ^ qty rec'd
13 ; ^ total item cost ^ total discount ^ delivery date
14 ; PRCVCR = the date/time the receiving report was created
15 ; PRCVDAT = The date/time of deletion processing
16 ;
17 N PRCVRA,PRCVRN,PRCVIEN,PRCVY
18 S PRCVID=$P(PRCV,"^",1) Q:PRCVID']"" ; DM DOC ID
19 S PRCVRN=$O(^PRCV(414.02,"B",PRCVID,0)) ; find DM DOC ID record
20 I +PRCVRN'>0 D MAIL("X1",POIEN,PRCVID,$P(PRCV,"^",2)) Q ; notify users that DM DOC ID record not in audit file
21 S PRCVIEN="+1,"_PRCVRN_","
22 S PRCVRA(414.021,PRCVIEN,.01)=PRCVDAT ; D/T RR deleted
23 S PRCVRA(414.021,PRCVIEN,1)=DUZ ; user deleting RR
24 S PRCVRA(414.021,PRCVIEN,2)=PRCVCR ; RR create D/T
25 S PRCVRA(414.021,PRCVIEN,3)=0-$P(PRCV,"^",10) ; Qty
26 S PRCVRA(414.021,PRCVIEN,4)=0-$P(PRCV,"^",11) ; total cost
27 S PRCVRA(414.021,PRCVIEN,5)=0-$P(PRCV,"^",12) ; discount
28 D UPDATE^DIE("","PRCVRA","PRCVY")
29 I $D(^TMP("DIERR",$J)) D MAIL("X5",POIEN,PRCVID,$P(PRCV,"^",2)) ; tell users that Audit file could not be updated
30 S $P(^TMP("PRCV442A",$J,POIEN),"^",7)=PRCVDAT
31 Q
32 ;
33DELAUD(PRCVID,PRCVDATE,PRCVDUZ,POIEN,PRCVITEM,PRCVIT) ; UPDATE AUDIT FILE FOR DELETED ITEMS
34 ;
35 ; PRCVID = the DM Doc ID of the item being deleted
36 ; PRCVDATE = the date/time the item is deleted or PO is cancelled
37 ; PRCVDUZ = the user deleting the item or canceling the PO
38 ; POIEN = the ien of the purchase order from which the receiving
39 ; report is being deleted.
40 ; PRCVITEM = the item number
41 ; PRCVIT = set to 1 if deleted at line item level, else PC cancel
42 ;
43 N PRCVD,PRCVDA,PRCVIEN,PRCVY
44 S PRCVY="C" I PRCVIT=1 S PRCVY="D"
45 S PRCVDA=$O(^PRCV(414.02,"B",PRCVID,0)) ; find DM DOC ID record
46 I PRCVDA']"" D MAIL(PRCVY_1,POIEN,PRCVID,PRCVITEM) Q ; DM DOC ID not in audit file
47 S PRCVD(414.02,PRCVDA_",",8)=PRCVDATE
48 S PRCVD(414.02,PRCVDA_",",9)=PRCVDUZ
49 D UPDATE^DIE("","PRCVD")
50 I $D(^TMP("DIERR",$J)) D MAIL(PRCVY_5,POIEN,PRCVID,PRCVITEM) ; tell user audit file not updated
51 Q
52 ;
53 ;
54DELITEM(POIEN) ; delete line item, get key info for DYNAMED
55 ; called from "AK" cross ref in DD - .01 of file 442.01 (Item multiple)
56 ;
57 ; POIEN = the ien of the purchase order (file 442)
58 ;
59 N PRCV,PRCVP
60 S PRCVP=""
61 D OP^XQCHK I $P(XQOPT,"^",1)="PRCHPC PO REMOVE 2237" Q ; this option does not cancel item out of IFCAP
62 I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 Q ; DM interface not active
63 D GETS^DIQ(442,POIEN_",",".01;.02;.07;5;7;62","IE","PRCVP") ; get PO data
64 S $P(PRCV,"^",7)=POIEN,POIEN=POIEN_","
65 I $D(^TMP("DIERR",$J)) G DELITEM1 ; PO data not on file,send to DM anyway
66 S $P(PRCV,"^",8)=PRCVP(442,POIEN,.02,"I") ; MOP (#.02 - n0,p2)
67 S $P(PRCV,"^",1)=PRCVP(442,POIEN,.01,"E") ; PO# (#.01 n0,p1)
68 S $P(PRCV,"^",4)=PRCVP(442,POIEN,5,"I") ; vendor IEN (#5 n1 p1)
69 S $P(PRCV,"^",5)=PRCVP(442,POIEN,62,"E") ; for PC orders MOP=25, 2237 is in #62 N23,P23
70 S $P(PRCV,"^",6)=PRCVP(442,POIEN,.07,"E") ; for inv/rec MOP=1, 2237 is in #.07 - n0,p12
71 S $P(PRCV,"^",2)=PRCVP(442,POIEN,7,"I") ; delivery date (#7 n0p10)
72DELITEM1 S $P(PRCV,"^",10)=$$NOW^XLFDT
73 S $P(PRCV,"^",11)=DA
74 ;
75 ; get DUZ
76 S $P(PRCV,"^",3)=DUZ
77 ;
78 ; X1 is the array of variables set in the execution of the 'AK' cross reference
79 S X1(999999)=PRCV ; save PO data to variables passed to background job
80 ;
81 D OPKG^XUHUI("","PRCV 442 ITEM DELETE","K","AK") ; invoke background job
82 K X1(999999) ; not to go back DD
83 Q
84 ;
85DELJOB ; send deleted item's info to DynaMed (collected by DELITEM subroutine)
86 ; called from protocol PRCV 442 ITEM DELETE and jobbed by TaskMan
87 ; builds
88 ; PRCVI (string for each item)
89 ; DM DOC ID ^ Item ien ^ line item # ^ 2237 ien ^ UOP ^ qty ordered
90 ; ^ unit price ^ NIF ^ pkg mult ^ qty rec'd ^ total item cost ^
91 ; total discount ^ delivery date
92 ; PRCV (header) variable -
93 ; PO# ^ txn type ^ DUZ ^ vendor IEN ^ FMS vendor # ^Alt add ind ^
94 ; txn D/T ^ Station# ^ Purchasing Station
95 ;
96 N POIEN,PRCV,PRCVERR,PRCVI,PRCVP,PRCVV,PRCV2237
97 ; QUIT IF mop'1 AND '=25
98 S PRCVP=XUHUIX1(999999) I $P(PRCVP,"^",8)'=1,$P(PRCVP,"^",8)'=25 Q
99 S POIEN=$P(PRCVP,"^",7)
100 K ^TMP("PRCV442A",$J,POIEN)
101 S PRCV=$P(PRCVP,"^",1,4),$P(PRCV,"^",7)=$P(PRCVP,"^",10)
102 ; get FMS vendor ID & alt addr code from file 440, #34&#35 - n3 p4&5
103 I $P(PRCV,"^",4)]"" D GETS^DIQ(440,$P(PRCV,"^",4)_",","34:35","E","PRCVV")
104 I $D(^TMP("DIERR",$J)) G DELJOB1 ; vendor data not on file
105 S $P(PRCV,"^",2)=5 ; DELETE
106 S $P(PRCV,"^",5)=PRCVV(440,$P(PRCV,"^",4)_",",34,"E") ; FMS vendor ID
107 S $P(PRCV,"^",6)=PRCVV(440,$P(PRCV,"^",4)_",",35,"E") ; FMA alt add ind
108 ; get Station Number
109DELJOB1 S $P(PRCV,"^",8)=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
110 S ^TMP("PRCV442A",$J,POIEN)=PRCV
111 S PRCVI=XUHUIX1(2)_"^"_XUHUIX1(3)_"^"_XUHUIX1(1)_"^^^"_XUHUIX1(4)_"^"_XUHUIX1(7)_"^^"_XUHUIX1(6)
112 S $P(PRCVI,"^",5)=$$GET1^DIQ(420.5,XUHUIX1(5),.01,"E") ; UOP
113 S $P(PRCVI,"^",8)=$$GET1^DIQ(441,XUHUIX1(3),51) ; NIF
114 S $P(PRCVI,"^",13)=$P(PRCVP,"^",2) ; DELIVERY DATE FOR PO
115 S PRCV2237=XUHUIX1(8)
116 I PRCV2237]"" S PRCV2237=$$GET1^DIQ(410,PRCV2237,.01,"E")
117 I PRCV2237']"" S PRCV2237=$P(PRCVP,"^",6)
118 I PRCV2237']"" S PRCV2237=$P(PRCVP,"^",5)
119 S $P(PRCVI,"^",4)=PRCV2237
120 D DELAUD($P(PRCVI,"^",1),$P(PRCV,"^",7),$P(PRCV,"^",3),POIEN,$P(PRCVI,"^",2),1)
121 S ^TMP("PRCV442A",$J,POIEN,$P(PRCVP,"^",11))=PRCVI
122 I $O(^TMP("PRCV442A",$J,POIEN,""))']"" S PRCVERR=1 D Q Q ; no DynaMed items
123 D EN^PRCVPOSD(POIEN)
124 Q
125 ;
126MAIL(PRCVCODE,PRCVPIEN,PRCVID,PRCVITEM) ; PREPARE VALUES FOR MESSAGE TO USERS
127 ;
128 ; $E(PRCVCODE,1) = U if the error occurred approving a PO
129 ; = C if the error occurred canceling a PO
130 ; = D if error occurred while deleting a line item
131 ; = R if the error occurred signing a Receipt Report
132 ; = X if the error occurred deleting a Receipt Report
133 ; $E(PRCVCODE,2) = DM Doc ID not in Audit File
134 ; = 2 if the PO data could not be found
135 ; = 3 if the item data could not be found
136 ; = 4 if the receiving report info for item was not found
137 ; = 5 if data could not be saved in audit file
138 ;
139 ; PRCVPIEN IEN of selected purchase order
140 ; PRCVID DM Doc ID of affected item
141 ; PRCVITEM ien of item (item#)
142 ;
143 N PRCVSITE,PRCVFCP,PRCVPO,XMB
144 K ^TMP($J,"PRCV442B")
145 S XMB(1)=$S($E(PRCVCODE,1)="C":"cancelling a PC order",$E(PRCVCODE,1)="D":"deleting a line item from a purchase order",1:"deleting a receiving report")
146 S XMB(2)=PRCVID
147 S XMB(3)=" "_PRCVID_" is not in file 414.02 - can't add related data"
148 I $E(PRCVCODE,2)=5 D
149 . S XMB(3)="System can't update Audit File (414.02) for "_PRCVID
150 . D TMPERR
151 S PRCVPO=$P($G(^PRC(442,PRCVPIEN,0)),"^",1)
152 S ^TMP($J,"PRCV442B",1)="Purchase Order# "_PRCVPO
153 S ^TMP($J,"PRCV442B",2)="ITEM# "_PRCVITEM
154 S ^TMP($J,"PRCV442B")=2
155 S PRCVSITE=PRCVPO+0 I PRCVSITE=0 S PRCVSITE=PRC("SITE")
156 S PRCVFCP=$P($G(^PRC(442,PRCVPIEN,0)),"^",3)
157 S PRCVFCP=$P(PRCVFCP," ",1)
158 D DMERXMB^PRCVLIC("PRCV442B",PRCVSITE,PRCVFCP)
159 K ^TMP($J,"PRCV442B")
160 Q
161 ;
162TMPERR ;
163 ;
164 ;
165 N PRCJ,PRCK S PRCK=$G(^TMP($J,"PRCV442B")),PRCJ=0
166 F S PRCJ=$O(^TMP("DIERR",$J,PRCJ)) Q:PRCJ'?1.N D
167 . I $D(^TMP("DIERR",$J,PRCJ,"TEXT",1)) D
168 . . S PRCK=PRCK+1,^TMP($J,"PRCV442B",PRCK)="Reason: "_^TMP("DIERR",$J,PRCJ,"TEXT",1)
169 . . S:$D(^TMP("DIERR",$J,PRCJ,"PARAM","IENS")) ^TMP($J,"PRCV442B",PRCK)=$E(^TMP($J,"PRCV442B",PRCK),1,220)_"-IENS: "_^TMP("DIERR",$J,PRCJ,"PARAM","IENS")
170 S:PRCK>0 ^TMP($J,"PRCV442B")=PRCK
171 K ^TMP("DIERR",$J)
172 Q
173 ;
174FCP(PRCVPO) ; return FCP for PO#
175 ;
176 ; PRCVPO = the external purchase order number
177 ; returns -1 if the PO or its FCP cannot be found
178 ;
179 N PRCVF,PRCVI
180 S PRCVF=-1
181 S PRCVI=$O(^PRC(442,"B",PRCVPO,0))
182 I PRCVI]"" D
183 . S PRCVI=$$GET1^DIQ(442,PRCVI_",",1,"E")
184 . I PRCVI]"" S PRCVF=$P(PRCVI," ",1)
185 Q PRCVF
186 ;
187Q I PRCVERR K ^TMP("PRCV442A",$J)
188 Q
Note: See TracBrowser for help on using the repository browser.