source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVIT.m@ 1710

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1PRCVIT ;WOIFO/DST - Send ITEM master file update to DYNAMED ; 3/2/05 5:07pm
2 ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6NITECHK ;
7 ; Once a day check
8 ; Compare a checksum and set a record to update
9 ;
10 ; If not DynaMed, don't do it
11 Q:'$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
12 ;
13 N PRCND,PRCVL,PRCVP,PRCVAL,PRCVIT,PRCVN,PRCVSTN
14 N PRCVFN
15 S PRCVP=67280421310721,PRCVN=99999
16 S PRCVFN=$O(^PRCV(414.04,"D","ITEM",0))
17 ; Clear old flag
18 K ^TMP("PRCVIT",$J)
19 S PRCVSTN=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
20 F S PRCVN=$O(^PRC(441,PRCVN)) Q:'PRCVN D
21 . S PRCVAL=$$CHKSUM()
22 . ; Compare to existing CheckSum
23 . ; Kick off HL7 interface message to DynaMed, if not the same
24 . I PRCVAL,PRCVAL'=$P($G(^PRCV(414.04,PRCVFN,1,PRCVN,0)),U,2) D
25 .. S ^PRCV(414.04,PRCVFN,1,PRCVN,0)=PRCVN_U_PRCVAL
26 .. D GETDATA(PRCVN)
27 .. I $D(^TMP("PRCVIT",$J,PRCVN)) D EN^PRCVIMF(PRCVN)
28 .. Q
29 . Q
30 K ^TMP("PRCVIT",$J)
31 Q
32 ;
33ONECHK(PRCVN) ;
34 ; Checksum to one ITEM only
35 Q:PRCVN<99999
36 N PRCND,PRCVL,PRCVFN,PRCVP,PRCVAL,PRCVIT
37 K ^TMP("PRCVIT",$J,PRCVN)
38 S PRCVP=67280421310721
39 S PRCVFN=$O(^PRCV(414.04,"D","ITEM",0))
40 S PRCVAL=$$CHKSUM()
41 ; If checksum not equal 0, get data to DynaMed
42 I PRCVAL,PRCVAL'=$P($G(^PRCV(414.04,PRCVFN,1,PRCVN,0)),U,2) D
43 . D GETDATA(PRCVN)
44 . S ^PRCV(414.04,PRCVFN,1,PRCVN,0)=PRCVN_U_PRCVAL
45 . I $D(^TMP("PRCVIT",$J,PRCVN)) D EN^PRCVIMF(PRCVN)
46 . Q
47 K ^TMP("PRCVIT",$J,PRCVN)
48 Q
49INIT ;
50 ; Initialize checksum global at installation
51 N PRCVN,PRCVP,RESULT,FDA
52 ;
53 S FDA(414.04,"?+1,",.01)="ITEM"
54 S FDA(414.04,"?+1,",.02)=441
55 S FDA(414.04,"?+1,",.03)="Item file checksum (on partial field)"
56 D UPDATE^DIE("E","FDA","RESULT")
57 S PRCVP=67280421310721,PRCVN=99999
58 F S PRCVN=$O(^PRC(441,PRCVN)) Q:'PRCVN D
59 . S FDA(414.41,"?+1,"_RESULT(1)_",",.01)=PRCVN
60 . S FDA(414.41,"?+1,"_RESULT(1)_",",1)=$$CHKSUM()
61 . D UPDATE^DIE("E","FDA")
62 Q
63 ;
64CHKSUM() ;
65 N PRCVST
66 S PRCVAL=0
67 ; Node 0
68 S PRCVIT=$G(^PRC(441,PRCVN,0))
69 ; Piece 1 - ITEM Number
70 ; Piece 2 - ITEM Short Description
71 ; Piece 3 - FSC - Federal Supply Classification
72 ; Piece 4 - Last vendor ordered
73 ; Piece 5 - NSN - National Stock Number
74 ; Piece 6 - Case/Cart Tray/instrument kit
75 ; Piece 8 - Mandatory Source
76 ; Piece 9 - Date Item Created
77 ; Piece 10 - BOC
78 ; Piece 11 - DUZ
79 ; Piece 13 - Reusable Item
80 ; Piece 14 - Hazardous material
81 ; Piece 15 - NIF ITEM number
82 S PRCVI=0
83 F PRCVI=1:1:6,8:1:11,13:1:15 D
84 . S PRCVST=$P(PRCVIT,U,PRCVI)
85 . S PRCVAL=$$CKINC(PRCVAL,PRCVST)
86 . Q
87 ; Node 1 - Description
88 ;
89 S PRCVI=0
90 F S PRCVI=$O(^PRC(441,PRCVN,1,PRCVI)) Q:'PRCVI D
91 . S PRCVST=^PRC(441,PRCVN,1,PRCVI,0)
92 . S PRCVAL=$$CKINC(PRCVAL,PRCVST)
93 . Q
94 ; Node 2 - Vendors
95 S PRCVI=0
96 F S PRCVI=$O(^PRC(441,PRCVN,2,PRCVI)) Q:'PRCVI D
97 . S PRCVST=^PRC(441,PRCVN,2,PRCVI,0)
98 . S PRCVAL=$$CKINC(PRCVAL,PRCVST)
99 . Q
100 ; Node 3
101 ; Piece 1 - Inactivated ITEM?
102 ; Piece 2 - Date Inactivated
103 ; Piece 3 - Inactivated By
104 ; Piece 4 - Replacement Item
105 ; Piece 5 - MFG Part No.
106 ; Piece 6 - NSN Verified
107 ; Piece 7 - Food Group
108 ; Piece 8 - SKU
109 ; Piece 9 - Drug Type Code
110 ; Piece 10 - SIC Code
111 ;
112 ; Check the whole node 3
113 ;
114 S PRCVST=$G(^PRC(441,PRCVN,3))
115 I PRCVST]"" S PRCVAL=$$CKINC(PRCVAL,PRCVST)
116 ;
117 ; Node 4 - Fund Control Point
118 S PRCVI=0
119 F S PRCVI=$O(^PRC(441,PRCVN,4,PRCVI)) Q:'PRCVI D
120 . S PRCVST=$G(^PRC(441,PRCVN,4,PRCVI,0))
121 . S PRCVAL=$$CKINC(PRCVAL,PRCVST)
122 . Q
123 ; Node 6 - Pre_NIF Long Description
124 S PRCVI=0
125 F S PRCVI=$O(^PRC(441,PRCVN,6,PRCVI)) Q:'PRCVI D
126 . S PRCVST=^PRC(441,PRCVN,6,PRCVI,0)
127 . S PRCVAL=$$CKINC(PRCVAL,PRCVST)
128 . Q
129 ;
130 Q PRCVAL
131 ;
132GETDATA(PRCVNM) ;
133 ; Get all field required,
134 ; Node 0
135 ;
136 N PRCVND,PRCVI,PRCVJ,PRCVCON,PRCVERR
137 S PRCVERR=0
138 S PRCVIT=$G(^PRC(441,PRCVNM,0))
139 S PRCVND=$P(PRCVIT,U,1,6)
140 S PRCVJ=6
141 F PRCVI=8:1:11,13,14,15 D
142 . S PRCVJ=PRCVJ+1
143 . S $P(PRCVND,U,PRCVJ)=$P(PRCVIT,U,PRCVI)
144 . Q
145 S $P(PRCVND,U,11)="N"
146 S:$P(PRCVIT,U,13)="Y"!("y") $P(PRCVND,U,11)="Y"
147 S ^TMP("PRCVIT",$J,PRCVNM,0)=PRCVND
148 ;
149 ; Node 1 - Description
150 S PRCVI=0
151 F S PRCVI=$O(^PRC(441,PRCVNM,1,PRCVI)) Q:'PRCVI D
152 . S ^TMP("PRCVIT",$J,PRCVNM,1,PRCVI)=^PRC(441,PRCVNM,1,PRCVI,0)
153 . Q
154 ; Node 2 - Vendors
155 S PRCVI=0
156 F S PRCVI=$O(^PRC(441,PRCVNM,2,PRCVI)) Q:'PRCVI D
157 . S PRCVND=^PRC(441,PRCVNM,2,PRCVI,0)
158 . ; Check if the contract exists in Vendor File
159 . ; If not, send a message to Control Point officer
160 . I $P(PRCVND,U)']"" S $P(PRCVND,U)=0
161 . I $P(PRCVND,U,3)']"" S $P(PRCVND,U,3)=0
162 . S PRCVCON=$G(^PRC(440,$P(PRCVND,U),4,$P(PRCVND,U,3),0))
163 . I $P(PRCVND,U)>0,($P(PRCVND,U,3)>0),($P(PRCVCON,U)']"") D
164 .. S PRCVERR=PRCVERR+1
165 .. S PRCVERR(PRCVERR)="Contract # "_$P(PRCVND,U,3)_" of VENDOR - "_$P(PRCVND,U)_", "_$P($G(^PRC(440,$P(PRCVND,U),0)),U)_", for ITEM # "_PRCVNM_" does not exist in IFCAP Vendor file."
166 .. S $P(PRCVND,U,3)=""
167 .. Q
168 . ; Check exp. date of contract, QUIT if expired more than 365 days
169 . I $P(PRCVCON,U,3)]"",($P(PRCVCON,U,3)<$$FMADD^XLFDT(DT,-365)) S $P(PRCVND,U,3)=""
170 . ; Conversion on PRCVND
171 . S:$P(PRCVND,U,2)="" $P(PRCVND,U,2)=0
172 . S:$P(PRCVND,U,8)="" $P(PRCVND,U,8)=1
173 . S ^TMP("PRCVIT",$J,PRCVNM,2,PRCVI)=PRCVND
174 . Q
175 ; Node 3
176 I $D(^PRC(441,PRCVNM,3)) S ^TMP("PRCVIT",$J,PRCVNM,3)=^PRC(441,PRCVNM,3)
177 ;
178 ; Node 4 - Fund Control Point
179 S PRCVI=0
180 F S PRCVI=$O(^PRC(441,PRCVNM,4,PRCVI)) Q:'PRCVI D
181 . S PRCVND=^PRC(441,PRCVNM,4,PRCVI,0)
182 . S $P(PRCVND,U)=$E($P(PRCVND,U),4,7)
183 . S ^TMP("PRCVIT",$J,PRCVNM,4,PRCVI)=PRCVND
184 . Q
185 ;
186 ; Node 6 - Pre_NIF Long Description
187 S PRCVI=0
188 F S PRCVI=$O(^PRC(441,PRCVNM,6,PRCVI)) Q:'PRCVI D
189 . S ^TMP("PRCVIT",$J,PRCVNM,6,PRCVI)=^PRC(441,PRCVNM,6,PRCVI,0)
190 . Q
191 ; If there are error(s), inform user by e-mail
192 I PRCVERR>0 D XMD
193 Q
194 ;
195XMD ; Send a message to Control Point officer/clerk for data mismatch
196 ;
197 N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
198 S XMSUB="Inventory System ITEM Update Info "_$$HTE^XLFDT($H)
199 S XMDUZ="IFCAP/COTS Inventory Interface"
200 S XMTEXT="PRCVERR("
201 ; S PRCVERR(1)="Contract "_PRCVCON_" of VENDOR # "_$P(PRCVND,U)_" for ITEM # "_PRCVNM_" does not existed in IFCAP Vendor file."
202 S XMY("G.PRCV Item Vendor Edits")=""
203 D ^XMD
204 Q
205 ;
206CKINC(PRCVF,PRCVS) ;incremental checksum
207 N LEN,FIB,C,I,PRCVAL,TEST
208 S TEST=PRCVF
209 S PRCVF=+$G(PRCVF)
210 S PRCVS=$G(PRCVS)
211 ;No change on null input
212 Q:PRCVS="" PRCVF
213 S LEN=$L(PRCVS)
214 S PRCVAL=0
215 S FIB(1)=1,FIB(2)=1
216 F I=1:1:LEN D
217 .S C=$E(PRCVS,I)
218 .S:I>2 FIB(I)=FIB(I-1)+FIB(I-2)#2147483647
219 .S PRCVAL=(PRCVF+PRCVAL+($A(C)*FIB(I)))#PRCVP
220 Q PRCVAL
Note: See TracBrowser for help on using the repository browser.