[613] | 1 | IVMPREC6 ;ALB/KCL/BRM - PROCESS INCOMING (Z05 EVENT TYPE) HL7 MESSAGES ; 12/29/2004
|
---|
| 2 | ;;2.0; INCOME VERIFICATION MATCH ;**3,4,12,17,34,58,79,102**; 21-OCT-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ; This routine will process batch ORU demographic (event type Z05) HL7
|
---|
| 6 | ; messages received from the IVM center. Format of HL7 batch message:
|
---|
| 7 | ;
|
---|
| 8 | ; BHS
|
---|
| 9 | ; {MSH
|
---|
| 10 | ; PID
|
---|
| 11 | ; ZPD
|
---|
| 12 | ; ZGD
|
---|
| 13 | ; RF1 (optional)
|
---|
| 14 | ; }
|
---|
| 15 | ; BTS
|
---|
| 16 | ;
|
---|
| 17 | ;
|
---|
| 18 | EN ; - entry point to process HL7 patient demographic message
|
---|
| 19 | ;
|
---|
| 20 | N DGENUPLD,VAFCA08,DGRUGA08
|
---|
| 21 | ;
|
---|
| 22 | ; prevent a return Z07 when uploading a Z05 (Patient file triggers)
|
---|
| 23 | S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS"
|
---|
| 24 | ;
|
---|
| 25 | ; prevent MPI A08 message when uploading Z05 (Patient file triggers)
|
---|
| 26 | S VAFCA08=1 ;MPI/CIRN A08 suppression flag
|
---|
| 27 | ;
|
---|
| 28 | S IVMFLG=0
|
---|
| 29 | ; - get incoming HL7 message from HL7 Transmission (#772) file
|
---|
| 30 | F IVMDA=0:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D
|
---|
| 31 | .K HLERR
|
---|
| 32 | .;
|
---|
| 33 | .; - message control id from MSH segment
|
---|
| 34 | .S MSGID=$P(IVMSEG,HLFS,10),HLMID=MSGID
|
---|
| 35 | .;
|
---|
| 36 | .; - perform demographics message consistency check
|
---|
| 37 | .D EN^IVMPRECA Q:$D(HLERR)
|
---|
| 38 | .;
|
---|
| 39 | .; - get next msg segment
|
---|
| 40 | .D NEXT I $E(IVMSEG,1,3)'="PID" D Q
|
---|
| 41 | ..S HLERR="Missing PID segment" D ACK^IVMPREC
|
---|
| 42 | .;
|
---|
| 43 | .; - patient IEN (DFN) from PID segment
|
---|
| 44 | .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH),1)
|
---|
| 45 | .;
|
---|
| 46 | .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
|
---|
| 47 | ..S HLERR="Invalid DFN" D ACK^IVMPREC
|
---|
| 48 | .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
|
---|
| 49 | ..S HLERR="Couldn't match HEC SSN with DHCP SSN" D ACK^IVMPREC
|
---|
| 50 | .;
|
---|
| 51 | .; - check for entry in IVM PATIENT file, otherwise create stub entry
|
---|
| 52 | .S IVM3015=$O(^IVM(301.5,"B",DFN,0))
|
---|
| 53 | .I 'IVM3015 S IVM3015=$$LOG^IVMPLOG(DFN,DT)
|
---|
| 54 | .I 'IVM3015 D Q
|
---|
| 55 | ..S HLERR="Failed to create entry in IVM PATIENT file"
|
---|
| 56 | ..D ACK^IVMPREC
|
---|
| 57 | .;
|
---|
| 58 | .; - compare PID segment fields with DHCP fields
|
---|
| 59 | .D COMPARE(IVMSEG) Q:$D(HLERR)
|
---|
| 60 | .;
|
---|
| 61 | .; - get next msg segment
|
---|
| 62 | .D NEXT I $E(IVMSEG,1,3)'="ZPD" D Q
|
---|
| 63 | ..S HLERR="Missing ZPD segment" D ACK^IVMPREC
|
---|
| 64 | .;
|
---|
| 65 | .; - compare ZPD segment fields with DHCP fields
|
---|
| 66 | .D COMPARE(IVMSEG)
|
---|
| 67 | .;
|
---|
| 68 | .; - get next msg segment
|
---|
| 69 | .D NEXT I $E(IVMSEG,1,3)="ZEL" D Q
|
---|
| 70 | ..S HLERR="ZEL segment should not be sent in Z05 message" D ACK^IVMPREC
|
---|
| 71 | .;
|
---|
| 72 | .; - get next msg segment
|
---|
| 73 | .I $E(IVMSEG,1,3)'="ZGD" D Q
|
---|
| 74 | ..S HLERR="Missing ZGD segment" D ACK^IVMPREC
|
---|
| 75 | .;
|
---|
| 76 | .; - compare ZGD segment fields with DHCP fields
|
---|
| 77 | .D COMPARE(IVMSEG)
|
---|
| 78 | .;S IVMFLG=0
|
---|
| 79 | .;
|
---|
| 80 | .; - check for RF1 segment and get segment if it exists
|
---|
| 81 | .; This process will automatically update patient address data
|
---|
| 82 | .; in the Patient (#2) file if the incoming address is more
|
---|
| 83 | .; recent than the existing one.
|
---|
| 84 | .I $$RF1CHK(IVMRTN,IVMDA) D NEXT,COMPARE(IVMSEG) S IVMFLG=0
|
---|
| 85 | ;
|
---|
| 86 | ; - send mail message if necessary
|
---|
| 87 | I IVMCNTR D MAIL^IVMUFNC()
|
---|
| 88 | ; Cleanup variables if no msg necessary
|
---|
| 89 | I 'IVMCNTR K IVMTEXT,XMSUB
|
---|
| 90 | ;
|
---|
| 91 | ENQ ; - cleanup variables
|
---|
| 92 | K DA,DFN,IVMADDR,IVMADFLG,IVMDA,IVMDHCP,IVMFLAG,IVMFLD,IVMPIECE,IVMSEG,IVMSTART,IVMXREF,DGENUPLD
|
---|
| 93 | Q
|
---|
| 94 | ;
|
---|
| 95 | ;
|
---|
| 96 | NEXT ; - get the next HL7 segment in the message from HL7 Transmission (#772) file
|
---|
| 97 | ;
|
---|
| 98 | S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0))
|
---|
| 99 | Q
|
---|
| 100 | ;
|
---|
| 101 | ;
|
---|
| 102 | COMPARE(IVMSEG) ; - compare incoming HL7 segment/fields with DHCP fields
|
---|
| 103 | ;
|
---|
| 104 | ; Input: IVMSEG -- as the text of the incoming HL7 message
|
---|
| 105 | ;
|
---|
| 106 | ; Output: None
|
---|
| 107 | ;
|
---|
| 108 | ; - get 3 letter HL7 segment name
|
---|
| 109 | S IVMXREF=$P(IVMSEG,HLFS,1),IVMSTART=IVMXREF
|
---|
| 110 | ;
|
---|
| 111 | ; - strip off HL7 segment name
|
---|
| 112 | S IVMSEG=$P(IVMSEG,HLFS,2,99)
|
---|
| 113 | ;
|
---|
| 114 | ; - roll through "C" x-ref in IVM Demographic Upload Fields (#301.92) file
|
---|
| 115 | F S IVMXREF=$O(^IVM(301.92,"C",IVMXREF)) Q:IVMXREF']"" D
|
---|
| 116 | .S IVMDEMDA=$O(^IVM(301.92,"C",IVMXREF,"")) Q:IVMDEMDA']""
|
---|
| 117 | .I $$INACTIVE(IVMDEMDA) Q
|
---|
| 118 | .;
|
---|
| 119 | .; - compare incoming HL7 segment fields with DHCP fields
|
---|
| 120 | .I IVMXREF["PID",(IVMSTART["PID") D PID^IVMPREC8
|
---|
| 121 | .I IVMXREF["ZPD",(IVMSTART["ZPD") D ZPD^IVMPREC8
|
---|
| 122 | .I IVMXREF["ZGD",(IVMSTART["ZGD") D ZGD^IVMPREC8
|
---|
| 123 | .I IVMXREF["RF1",(IVMSTART["RF1") D RF1^IVMPREC8
|
---|
| 124 | Q
|
---|
| 125 | ;
|
---|
| 126 | ;
|
---|
| 127 | DEMBULL ; - build mail message for transmission to IVM mail group notifying
|
---|
| 128 | ; them that patients with updated demographic data has been received
|
---|
| 129 | ; from the IVM Center and may now be uploaded into DHCP.
|
---|
| 130 | ;
|
---|
| 131 | ; If record is auto uploaded, don't add veteran to bulletin
|
---|
| 132 | I $$CKAUTO Q
|
---|
| 133 | ;
|
---|
| 134 | S IVMPTID=$$PT^IVMUFNC4(DFN)
|
---|
| 135 | S XMSUB="IVM - DEMOGRAPHIC UPLOAD for "_$P($P(IVMPTID,"^"),",")_" ("_$P(IVMPTID,"^",3)_")"
|
---|
| 136 | S IVMTEXT(1)="Updated demographic information has been received from the"
|
---|
| 137 | S IVMTEXT(2)="Health Eligibilty Center. Please select the 'Demographic Upload'"
|
---|
| 138 | S IVMTEXT(3)="option from the IVM Upload Menu in order to take action on this"
|
---|
| 139 | S IVMTEXT(4)="demographic information. If you have any questions concerning the"
|
---|
| 140 | S IVMTEXT(5)="information received, please contact the Health Eligibility Center."
|
---|
| 141 | S IVMTEXT(7)=""
|
---|
| 142 | S IVMTEXT(8)="The Health Eligibilty Center has identified the following"
|
---|
| 143 | S IVMTEXT(9)="patients as having updated demographic information:"
|
---|
| 144 | S IVMTEXT(10)=""
|
---|
| 145 | S IVMCNTR=IVMCNTR+1
|
---|
| 146 | S IVMTEXT(IVMCNTR+10)=$J(IVMCNTR_")",5)_" "_$P(IVMPTID,"^")_" ("_$P(IVMPTID,"^",3)_")"
|
---|
| 147 | Q
|
---|
| 148 | ;
|
---|
| 149 | INACTIVE(IVMDEMDA) ;Check if field is inactive in Demographic Upload
|
---|
| 150 | ; Input -- IVMDEMDA IVM Demographic Upload Fields IEN
|
---|
| 151 | ; Output -- 1=Yes and 0=No
|
---|
| 152 | Q +$P($G(^IVM(301.92,IVMDEMDA,0)),U,9)
|
---|
| 153 | ;
|
---|
| 154 | RF1CHK(IVMRTN,IVMDA) ;does an RF1 segment exist in this message?
|
---|
| 155 | N RF1
|
---|
| 156 | S RF1=$O(^TMP($J,IVMRTN,IVMDA))
|
---|
| 157 | I $E($G(^(+RF1,0)),1,3)'="RF1" Q 0
|
---|
| 158 | Q 1
|
---|
| 159 | ;
|
---|
| 160 | CKAUTO() ;
|
---|
| 161 | ; Chect if message qualifies for an auto upload.
|
---|
| 162 | N AUTO,IVMI,DOD
|
---|
| 163 | S AUTO=0,IVMI=$O(^IVM(301.92,"C","ZPD09",""))
|
---|
| 164 | I IVMI=IVMDEMDA D
|
---|
| 165 | .I +IVMFLD'>0 S AUTO=1 Q
|
---|
| 166 | .S DOD=$P($G(^DPT(DFN,.35)),U)
|
---|
| 167 | .I DOD=IVMFLD S AUTO=1 Q
|
---|
| 168 | ;
|
---|
| 169 | Q AUTO
|
---|