[613] | 1 | PRCVVMF ;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 | ;
|
---|
| 7 | EN(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 | ;
|
---|
| 28 | HDRBLD ;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 | ;
|
---|
| 46 | MSGBLD ;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 | ;
|
---|
| 135 | MFKPROC ;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 | ;
|
---|
| 148 | ERROR ;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 | ;
|
---|
| 164 | CLIFP ;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 | ;
|
---|
| 176 | FIN ;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
|
---|