source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEHL4.m@ 789

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1IBCNEHL4 ;DAOU/ALA - HL7 Process Incoming RPI Msgs (cont.) ;26-JUN-2002 ; Compiled December 16, 2004 15:35:46
2 ;;2.0;INTEGRATED BILLING;**300**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This pgm will process the non-repeating segments of the
7 ; incoming IIV response msgs.
8 ; It was separated out from IBCNEHL2 to conserve space.
9 ;
10 ; This routine is based on IBCNEHLP which was introduced with patch 184, and subsequently
11 ; patched with patches 252 and 271. IBCNEHLP is obsolete and deleted with patch 300.
12 ;
13 ; * Each of these tags are called by IBCNEHL2.
14 ;
15 ; Variables
16 ; SEG = HL7 Seg Name
17 ; MSGID = Original Msg Control ID
18 ; ACK = Acknowledgment (AA=Accepted, AE=Error)
19 ; ERTXT = Error Msg Text
20 ; ERFLG = Error quit flag
21 ; ERACT = Error Action
22 ; ERCON = Error Condition
23 ; RIEN = Response Record IEN
24 ; IBSEG = Array of the segment
25 ;
26 Q ; No direct calls
27 ;
28MSA ; Process the MSA seg
29 ;
30 ; Input:
31 ; IBSEG,MGRP
32 ;
33 ; Output:
34 ; ERACT,ERCON,ERROR,ERTXT,RIEN,TRACE,ACK
35 ;
36 N MSGID,RSUPDT,VRFDT
37 S ACK=$G(IBSEG(2)),MSGID=$G(IBSEG(3)),TRACE=$G(IBSEG(4))
38 S ERTXT=$$DECHL7^IBCNEHL2($P($G(IBSEG(7)),$E(HLECH),2)),ERACT=$G(IBSEG(6)),ERCON=$P($G(IBSEG(7)),$E(HLECH),1)
39 ;
40 ; If no Control Id, send Mailman error msg
41 I MSGID="" D ERRMSA(TRACE,MGRP) S ERFLG=1 G MSAX
42 ;
43 ; Check for msg id/payer combination and get response IEN
44 D PCK^IBCNEHL3
45 ;
46 ; If no record IEN, quit
47 I $G(RIEN)="" G MSAX
48 ;
49 ; Update record w/info
50 S RSUPDT(365,RIEN_",",.09)=TRACE,RSUPDT(365,RIEN_",",.06)=3
51 S RSUPDT(365,RIEN_",",4.01)=ERTXT
52 S VRFDT=$$NOW^XLFDT(),RSUPDT(365,RIEN_",",.07)=VRFDT
53 ;
54 ; Update w/internal values
55 D FILE^DIE("I","RSUPDT","ERROR")
56 ;
57 S RSUPDT(365,RIEN_",",1.14)=ERCON,RSUPDT(365,RIEN_",",1.15)=ERACT
58 ;
59 ; Update w/external values
60 D FILE^DIE("E","RSUPDT","ERROR")
61MSAX ;
62 Q
63 ;
64ERRMSA(TRACE,MGRP) ; Msg Control Id is blank - Send Mailman error msg
65 ;
66 N HCT,ICN,MSG,MSGCT,NAME,XMSUB
67 ;
68 ;1st find the PID seg to extract ICN and patient name
69 D GTICNM^IBCNEHLU(.ICN,.NAME)
70 ;
71 ;Send the Mailman error msg
72 S XMSUB="Message Control Id Field is Blank",MSGCT=$S(TRACE="":4,1:3)
73 S MSG(1)="A response was received w/a blank Message Control Id"
74 I TRACE="" S MSG(1)=MSG(1)_" and Trace #"
75 S MSG(2)="for "_$S(TRACE'="":"Trace #: "_TRACE_", ",1:"")_"ICN #: "_ICN_", Patient: "_NAME_"."
76 I TRACE="" D
77 . S MSG(3)="It is likely that there are communication issues with the EC."
78 S MSG(MSGCT)="This response cannot be processed. Please log a NOIS."
79 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
80 Q
81 ;
82PID ; Process the PID seg
83 N DFN,DOB,DOD,ICN,LFAC,LUPDT,NAME,RSUPDT,SEX,SSN,XDFN,IDLIST
84 N SUBCNT,SUBC,SUBCID,SUBCDATA,IERN
85 ;
86 S ERFLG=0
87 S DOB=$G(IBSEG(8)),SEX=$G(IBSEG(9))
88 S NAME=$G(IBSEG(6))
89 S DOD=$G(IBSEG(30)),LUPDT=$G(IBSEG(34)),LFAC=$G(IBSEG(35))
90 ;
91 ; Parse Repeating ID field to fill in other identifiers
92 S (ICN,SSN,DFN)=""
93 S IDLIST=$G(IBSEG(4))
94 F SUBCNT=1:1:$L(IDLIST,$E(HLECH,2,2)) D
95 . S SUBC=$P(IDLIST,$E(HLECH,2,2),SUBCNT)
96 . S SUBCID=$P(SUBC,$E(HLECH),5) ; Identifier Type Code
97 . S SUBCDATA=$P(SUBC,$E(HLECH),1) ; Data Value
98 . I SUBCID="PI" S DFN=SUBCDATA
99 . I SUBCID="SS" S SSN=SUBCDATA
100 . I SUBCID="NI" S ICN=SUBCDATA
101 ;
102 ; Convert data from HL7 format to VistA format
103 S NAME=$$DECHL7^IBCNEHL2($$FMNAME^HLFNC(NAME,HLECH))
104 S DOD=$$FMDATE^HLFNC(DOD),DOB=$$FMDATE^HLFNC(DOB),LUPDT=$$FMDATE^HLFNC(LUPDT)
105 ;
106 ; Use ICN to find the patients DFN at this site
107 I ICN'="" S XDFN=$$GETDFN^MPIF001(ICN)
108 I +$G(XDFN)'>0,+$G(ICN)>0 D Q
109 . S ERFLG=1,IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
110 . S ERROR("DIERR",IERN,"TEXT",1)="Unable to determine the patient's DFN value for this site."
111 . S ERROR("DIERR",IERN,"TEXT",2)=" The ICN for the patient in this response is ICN: "_ICN
112 . S ERROR("DIERR",IERN,"TEXT",3)=" eIIV was unable to file the response information."
113 ;
114 I +ICN>0 S DFN=XDFN
115 ;
116 ; Perform date of death check
117 I DOD'="" D DODCK^IBCNEHLU(DFN,DOD,MGRP,NAME,RIEN,SSN)
118 ;
119 I $P(^IBCN(365,RIEN,0),U,2)="" S RSUPDT(365,RIEN_",",.02)=DFN
120 S RSUPDT(365,RIEN_",",1.02)=DOB,RSUPDT(365,RIEN_",",1.04)=SEX
121 S RSUPDT(365,RIEN_",",1.03)=SSN,RSUPDT(365,RIEN_",",1.16)=DOD
122 S RSUPDT(365,RIEN_",",1.01)=NAME,RSUPDT(365,RIEN_",",1.08)="v"
123 S RSUPDT(365,RIEN_",",1.09)="01"
124 D FILE^DIE("I","RSUPDT","ERROR")
125PIDX ;
126 Q
127 ;
128GT1 ; Process the GT1 Guarantor seg
129 ;
130 ; Input:
131 ; IBSEG,RIEN
132 ;
133 ; Output:
134 ; ERROR,SUBID
135 ;
136 N DOB,NAME,RSUPDT,SEX,SSN,SUBIDC
137 S NAME=$G(IBSEG(4)),DOB=$G(IBSEG(9)),SEX=$G(IBSEG(10))
138 S SSN=$G(IBSEG(13))
139 ;
140 S SUBIDC=$G(IBSEG(3)) ; Raw field with sub-comp.
141 S SUBID=$P(SUBIDC,$E(HLECH),1)
142 S SUBID=$$DECHL7^IBCNEHL2(SUBID)
143 ;
144 S DOB=$$FMDATE^HLFNC(DOB),NAME=$$DECHL7^IBCNEHL2($$FMNAME^HLFNC(NAME,HLECH))
145 ;
146 S RSUPDT(365,RIEN_",",1.01)=NAME,RSUPDT(365,RIEN_",",1.08)=""
147 S RSUPDT(365,RIEN_",",1.02)=DOB,RSUPDT(365,RIEN_",",1.04)=SEX
148 S RSUPDT(365,RIEN_",",1.03)=SSN
149 S RSUPDT(365,RIEN_",",1.18)=SUBID
150 D FILE^DIE("I","RSUPDT","ERROR")
151GT1X ;
152 Q
Note: See TracBrowser for help on using the repository browser.