source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVVMF.m@ 1154

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

initial load of WorldVistAEHR
File size: 5.8 KB
Line 
1PRCVVMF ;WOIFO/DAP-DYNAMED VENDOR UPDATE HL7 MESSAGING ROUTINE; 03/02/05
2 ;;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(PRCVVN) ;Entry point for API Call
8 I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 Q
9 I $D(PRCVVN)=0 Q
10 N HLA
11 S PRCVCNT=0,PRCVERG=0
12 D HDRBLD
13 I PRCVERG=1 K PRCVERG Q
14 ;
15 D MSGBLD
16 ;
17 S PRCVDP=""
18 D GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
19 I +$P(PRCVDP,"^",2) S PRCVERR(1)="Error generating message through VistA HL7 package for Vendor Update involving vendor # "_PRCVVN D CLIFP
20 ;
21 K ^TMP("PRCVNDR",$J,PRCVVN)
22 ;
23 D FIN
24 K PRCVERG
25 ;
26 Q
27 ;
28HDRBLD ;Generate message header, MFI Segment
29 ;
30 K HL S PRCVPRO="PRCV_IFCAP_04_EV_VEND_UPD"
31 D INIT^HLFNC2(PRCVPRO,.HL)
32 I $G(HL) S PRCVERR(1)="Error generating message through VistA HL7 package for Vendor Update involving vendor # "_PRCVVN D CLIFP D FIN Q
33 ;
34 S PRCVCS=$E(HL("ECH")),PRCVRS=$E(HL("ECH"),2),PRCVSS=$E(HL("ECH"),4),PRCVFS=HL("FS")
35 ;
36 ;PRCVDT Transaction Date/Time w/offset
37 D NOW^%DTC
38 S PRCVDT=$$FMTHL7^XLFDT(%)
39 ;
40 ;Build MFI Segment
41 S PRCVCNT=PRCVCNT+1
42 S HLA("HLS",PRCVCNT)="MFI"_PRCVFS_"OME"_PRCVFS_"440"_PRCVCS_"VENDOR"_PRCVFS_"UPD"_PRCVFS_PRCVDT_PRCVFS_PRCVFS_"AL"
43 ;
44 Q
45 ;
46MSGBLD ;Build Message Body
47 ;
48 ;PRCVNM Vendor Name
49 S PRCVNM=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",1)
50 ;Address Fields - HL7 String Conversions
51 S PRCV1="C",PRCV2=HL("FS")_HL("ECH")
52 ;PRCVAD1 Address 1
53 S PRCVAD1=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",2)
54 I PRCVAD1'="" D
55 . S PRCVAD1=$$CONV^PRCVUTSC(PRCVAD1,PRCV1,PRCV2)
56 . Q
57 ;PRCVAD2 Address 2
58 S PRCVAD2=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",3)
59 I PRCVAD2'="" D
60 . S PRCVAD2=$$CONV^PRCVUTSC(PRCVAD2,PRCV1,PRCV2)
61 . Q
62 ;PRCVAD3 Address 3
63 S PRCVAD3=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",4)
64 I PRCVAD3'="" D
65 . S PRCVAD3=$$CONV^PRCVUTSC(PRCVAD3,PRCV1,PRCV2)
66 . Q
67 ;PRCVAD4 Address 4
68 S PRCVAD4=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",5)
69 I PRCVAD4'="" D
70 . S PRCVAD4=$$CONV^PRCVUTSC(PRCVAD4,PRCV1,PRCV2)
71 . Q
72 ;PRCVCT City
73 S PRCVCT=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",6)
74 ;PRCVST State
75 S PRCVST=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",7)
76 ;PRCVZP Zip Code
77 S PRCVZP=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",8)
78 ;PRCVCPS Contact Person
79 S PRCVCPS=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",9)
80 ;PRCVCPH Contact Phone #
81 S PRCVCPH=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",10)
82 ;PRCVSTAT Station #
83 S PRCVSTAT=$P(^TMP("PRCVNDR",$J,PRCVVN,0),"^",11)
84 ;PRCVEDI Vendor EDI #
85 S PRCVEDI=$P(^TMP("PRCVNDR",$J,PRCVVN,1),"^",2)
86 ;PRCVFMS Vendor FMS #
87 S PRCVFMS=$P(^TMP("PRCVNDR",$J,PRCVVN,1),"^",3)
88 ;PRCVALT Alternate Address Indicator
89 S PRCVALT=$P(^TMP("PRCVNDR",$J,PRCVVN,1),"^",4)
90 ;PRCVINA Inactivation Date
91 S PRCVINA=$P(^TMP("PRCVNDR",$J,PRCVVN,2),"^",1)
92 I PRCVINA'="" S PRCVINA=$$FMTHL7^XLFDT(PRCVINA)
93 ;PRCVCFX Contact FAX #
94 S PRCVCFX=$P(^TMP("PRCVNDR",$J,PRCVVN,2),"^",3)
95 ;PRCVDNB Dun and Bradstreet #
96 S PRCVDNB=$P(^TMP("PRCVNDR",$J,PRCVVN,2),"^",4)
97 ;PRCVACN Account Number
98 S PRCVACN=$P(^TMP("PRCVNDR",$J,PRCVVN,2),"^",5)
99 ;
100 ;Handling Repeating Contract Number Array and Building HL7 Field ZVD.6
101 S N=0,B=0,PRCVCNA="" F S N=$O(^TMP("PRCVNDR",$J,PRCVVN,3,N)) Q:+N=0 D
102 . S PRCVED=$P(^TMP("PRCVNDR",$J,PRCVVN,3,N),"^",2)
103 . S V=$$FMADD^XLFDT(PRCVED,366) I (%<V)!(PRCVED="") D
104 .. S B=B+1,PRCVCN=$P(^TMP("PRCVNDR",$J,PRCVVN,3,N),"^",1)
105 .. S PRCVBD=$P(^TMP("PRCVNDR",$J,PRCVVN,3,N),"^",3)
106 .. I PRCVBD'="" S PRCVBD=$$FMTHL7^XLFDT(PRCVBD)
107 .. I PRCVED'="" S PRCVED=$$FMTHL7^XLFDT(PRCVED)
108 .. S PRCVCNA(B)=PRCVRS_PRCVCN_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVBD_PRCVCS_PRCVED
109 .. Q
110 . Q
111 ;
112 I $D(PRCVCNA(1)) S PRCVCNA(1)=$P(PRCVCNA(1),PRCVRS,2)
113 ;
114 ;Build MFE Segment
115 S PRCVCNT=PRCVCNT+1
116 S HLA("HLS",PRCVCNT)="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVVN_PRCVFS_PRCVFS_PRCVVN_PRCVCS_PRCVNM_PRCVCS_PRCVSTAT_PRCVFS_"CE"
117 ;
118 ;Build ZVD Segment
119 S PRCVCNT=PRCVCNT+1,R=0
120 S HLA("HLS",PRCVCNT)="ZVD"_PRCVFS_PRCVNM_PRCVCS_PRCVCS_PRCVVN_PRCVCS_PRCVCS_PRCVCS_PRCVCS_"IFCAP"_PRCVCS_PRCVSTAT_PRCVRS_PRCVNM_PRCVCS_PRCVCS_PRCVEDI_PRCVCS_PRCVCS_PRCVCS_PRCVCS_"EDI"_PRCVCS_PRCVSTAT_PRCVRS
121 S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVNM_PRCVCS_PRCVCS_PRCVFMS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_"FMS"_PRCVCS_PRCVSTAT_PRCVRS_PRCVNM_PRCVCS_PRCVCS_PRCVDNB_PRCVCS_PRCVCS_PRCVCS_PRCVCS_"Dun and Bradstreet"_PRCVCS_PRCVSTAT
122 S HLA("HLS",PRCVCNT,1)=PRCVFS_PRCVAD1_PRCVSS_PRCVAD2_PRCVSS_PRCVAD3_PRCVSS_PRCVAD4_PRCVCS_PRCVCS_PRCVCT_PRCVCS_PRCVST_PRCVCS_PRCVZP_PRCVFS_PRCVACN_PRCVFS_PRCVCPS_PRCVFS
123 S HLA("HLS",PRCVCNT,2)=PRCVCPH_PRCVCS_PRCVCS_"PH"_PRCVRS_PRCVCFX_PRCVCS_PRCVCS_"FX"_PRCVFS_PRCVCS_PRCVINA_PRCVFS
124 ;
125 I $D(PRCVCNA) S W=0,R=2 F S W=$O(PRCVCNA(W)) Q:+W=0 D
126 . S R=R+1
127 . S HLA("HLS",PRCVCNT,R)=PRCVCNA(W)
128 . Q
129 ;
130 I R<2 S R=2
131 S HLA("HLS",PRCVCNT,R+1)=PRCVFS_PRCVALT
132 ;
133 Q
134 ;
135MFKPROC ;Process MFK^M01 response message
136 ;
137 ;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
138 X HLNEXT
139 ;
140 X HLNEXT
141 S VAL=$$FLD^HLCSUTL(HLNODE,2)
142 I VAL'="AA" D ERROR
143 ;
144 D FIN
145 ;
146 Q
147 ;
148ERROR ;Process ERR Segments
149 S PRCVERC=2,PRCVERR(1)="Unable to update Vendor in DynaMed."
150 S PRCVERR(2)="During a Vendor Update to DynaMed the following errors occurred:"
151 F M=1:1 X HLNEXT Q:HLQUIT'>0 D
152 . S VAL=$$FLD^HLCSUTL(HLNODE,1)
153 . I VAL="MFA" S PRCVME=$$FLD^HLCSUTL(HLNODE,3)
154 . I VAL="ERR" D
155 .. S PRCVERC=PRCVERC+1,PRCVERM=$$FLD^HLCSUTL(HLNODE,6)
156 .. S PRCVERR(PRCVERC)=$P(PRCVERM,"^",2)
157 .. Q
158 . Q
159 ;
160 D CLIFP
161 ;
162 Q
163 ;
164CLIFP ;Call partner app w/ mail message for users on error
165 N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
166 S XMSUB="DynaMed Vendor # "_PRCVME_" Update Errors "_$$HTE^XLFDT($H)
167 S XMDUZ="IFCAP/COTS Inventory Interface"
168 S XMTEXT="PRCVERR("
169 S XMY("G.PRCV Item Vendor Edits")=""
170 ;
171 D ^XMD
172 S PRCVERG=1
173 ;
174 Q
175 ;
176FIN ;Clean up variables
177 K PRCVVN,PRCVCNT,PRCVDP,PRCVPRO,HL,PRCVCS,PRCVRS,PRCVFS,PRCVDT,%,PRCVNM,PRCVAD1,PRCVAD2,PRCVAD3,PRCVAD4,PRCVME
178 K PRCVCT,PRCVST,PRCVZP,PRCVCPS,PRCVCPH,PRCVSTAT,PRCVEDI,PRCVFMS,PRCVALT,PRCVINA,PRCVCFX,PRCVDNB,PRCVACN
179 K N,PRCVCNA,PRCVCN,PRCVBD,PRCVED,VAL,PRCVERC,PRCVERM,PRCVERR,PRCV1,PRCV2,STR1,PRCVSS,V,W,R,B,M
180 ;
181 Q
Note: See TracBrowser for help on using the repository browser.