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

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1IBCNEDEQ ;DAOU/ALA - Process Transactions continued ;21-AUG-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,300**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This program contains some subroutines for processing a transmission
7 ;
8HLER ; HL7 Creation error message
9 ;
10 ; Called from IBCNEDEP
11 ;
12 ; Parameters
13 ; HLRESLT = Error from GENERATE^HLMA call
14 ; DFN = Patient IEN
15 ; PAYR = Payer IEN
16 ; MGRP = Mail group
17 ; XMSUB = Subject line
18 ; MSG = Message array
19 ;
20 S HLRESLT="Error - "_$P(HLRESLT,U,2,99)
21 S MSG(1)=HLRESLT
22 S MSG(2)="occurred when trying to create the outgoing HL7 message for"
23 S MSG(3)="Patient: "_$P($G(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U,1)_"."
24 S MSG(4)="Please log a NOIS for this problem."
25 D TXT^IBCNEUT7("MSG")
26 S XMSUB="IIV HL7 Creation Error"
27 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
28 K XMSUB,MSG,HLRESLT
29 Q
30 ;
31CERR ; Communication Error Mail Message - No Retries defined
32 ;
33 ; Called from IBCNEDEP
34 ;
35 ; Parameters
36 ; DFN = Patient IEN
37 ; PAYR = Payer IEN
38 ; FMSG = Failure message flag
39 ; MGRP = Mail group
40 ; XMSUB = Subject line
41 ; MSG = Message array
42 ;
43 I 'FMSG G CERRQ
44 S XMSUB="IIV Communication Error"
45 S MSG(1)="VistA was unable to electronically confirm insurance for"
46 S MSG(2)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U)_"."
47 S MSG(3)="A single attempt was made to electronically confirm the insurance"
48 S MSG(4)="with this payer."
49 ;
50 D TXT^IBCNEUT7("MSG")
51 ;
52 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
53 K MSG,XMSUB
54CERRQ Q
55 ;
56CERE ; Communication Error Mail Message - Exceeds Retries
57 ;
58 ; Called from IBCNEDEP
59 ;
60 ; Parameters
61 ; DFN = Patient IEN
62 ; PAYR = Payer IEN
63 ; FMSG = Failure message flag
64 ; MGRP = Mail group
65 ; XMSUB = Subject line
66 ; MSG = Message array
67 ;
68 I 'FMSG G CEREQ
69 S XMSUB="IIV Communication Error"
70 S MSG(1)="VistA was unable to electronically confirm insurance for"
71 S MSG(2)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U)_"."
72 ;
73 D TXT^IBCNEUT7("MSG")
74 ;
75 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
76 K MSG,XMSUB
77CEREQ Q
78 ;
79SUB ; Create HL7 subrecord in TQ file
80 ;
81 ; Called from tag SCC within this routine
82 ;
83 ; Input Parameters
84 ; IEN = the transmission IEN
85 ; RSIEN = the response IEN
86 ; MDTM = the date/time message was created
87 ; MSGID = the HL7 message ID
88 ;
89 NEW DIC,DIE,X,DA,DLAYGO,Y
90 S DIC="^IBCN(365.1,"_IEN_",2,",DIE=DIC,X=MDTM,DA(1)=IEN
91 S DLAYGO=365.16,DIC(0)="L",DIC("P")=DLAYGO
92 I '$D(^IBCN(365.1,IEN,2,0)) S ^IBCN(365.1,IEN,2,0)="^365.16D^^"
93 K DD,DO
94 D FILE^DICN
95 K DO
96 S HIEN=+Y
97 S DR=".02////^S X=MSGID;.03////^S X=RSIEN" D ^DIE
98 S DA=HIEN D ^DIE
99 ;
100 K HIEN,RSIEN,DR,MDTM
101 Q
102 ;
103RESP ; Create Response Record
104 ;
105 ; Called from IBCNEHL3 tag SCC within this routine
106 ;
107 ; Input Parameters
108 ; MSGID = Message Control ID (required)
109 ; MDTM = Message date/time created (optional)
110 ; DFN = Patient IEN (optional)
111 ; PAYR = Payer IEN (optional)
112 ; BUFF = Buffer IEN (optional)
113 ; IEN = Transmission IEN (optional)
114 ; RSTYPE = Response Type (O=Original, U=Unsolicited)
115 ;
116 NEW DIC,DIE,X,DA,DLAYGO,Y,RARRAY
117 S DIC="^IBCN(365,",X=MSGID,DLAYGO=365,DIC(0)="L",DIC("P")=DLAYGO
118 K DD,DO
119 D FILE^DICN
120 K DO
121 S RSIEN=+Y
122 S RARRAY(365,RSIEN_",",.02)=$G(DFN),RARRAY(365,RSIEN_",",.03)=$G(PAYR)
123 I $G(IEN)'="" D
124 . I $P(^IBCN(365.1,IEN,0),U,18)=1 S RARRAY(365,RSIEN_",",.04)=$G(BUFF)
125 S RARRAY(365,RSIEN_",",.05)=$G(IEN)
126 S RARRAY(365,RSIEN_",",.06)=2,RARRAY(365,RSIEN_",",.08)=$G(MDTM)
127 ;
128 I $G(RSTYPE)="" S RSTYPE="U"
129 S RARRAY(365,RSIEN_",",.1)=RSTYPE
130 ;
131 D FILE^DIE("I","RARRAY","ERR")
132 I $D(ERR) D
133 . S ERFLG=1,MCT=0,VEN=0
134 . F S VEN=$O(ERR("DIERR",VEN)) Q:'VEN D
135 .. S MCT=MCT+1,MSG(MCT)=ERR("DIERR",VEN,"TEXT",1)
136 . ;
137 . S MCT=MCT+1,MSG(MCT)="Please log a NOIS for this problem."
138 . S XMSUB="Error creating Response"
139 . D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
140 . K ERR,VEN,MCT
141 Q
142 ;
143TMRR ; Communication Timeout message
144 I 'TMSG Q
145 S XMSUB="IIV Communication Timeout"
146 S MSG(1)="No Response has been received within the defined failure days of "_FAIL_" for "
147 S MSG(3)="Patient: "_$P($G(^DPT(DFN,0)),U,1)_$$SSN(DFN)_" and Payer: "_$P($G(^IBE(365.12,PAYR,0)),U,1)
148 ;
149 D TXT^IBCNEUT7("MSG")
150 ;
151 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
152 K MSG,XMSUB
153 Q
154 ;
155SSN(DFN) ; Retrieve patient's ssn and return last 4 digits
156 ; Subsequently added Date of Birth to display as well
157 Q:'$G(DFN) ""
158 N SSN,DOB
159 S SSN=$$GETSSN^IBCNEDE5(DFN)
160 S DOB=$$GETDOB(DFN)
161 I SSN="",DOB="" Q ""
162 I SSN="" Q " (DOB: "_DOB_")"
163 S SSN=" (SSN: xxx-xx-"_$E(SSN,6,9)
164 I DOB'="" S DOB=" DOB: "_DOB
165 Q SSN_DOB_")"
166 ;
167GETDOB(DFN) ;
168 Q:'$G(DFN) "Unknown"
169 N DOB
170 S DOB=$P($G(^DPT(DFN,0)),U,3)
171 S DOB=$S('DOB:"Unknown",1:$$FMTE^XLFDT(DOB,"5Z"))
172 Q DOB
173 ;
174SCC ; If successfully creates an HL7 msg
175 S MSGID=$P(HLRESLT,U,1),NTRAN=NTRAN+1,MDTM=$$NOW^XLFDT(),IHCNT=IHCNT+1
176 I NTRAN>1 S NRETR=NRETR+1
177 D SST^IBCNEUT2(IEN,2)
178 S DA=IEN,DIE="^IBCN(365.1,",DR=".07////^S X=NTRAN;.08////^S X=NRETR"
179 D ^DIE
180 ;
181 ; Create Response Record
182 S RSTYPE="O" D RESP
183 ;
184 ; Create HL7 subrecord
185 D SUB
186 ;
187 ; If a buffer entry exists, set the buffer symbol to a '?'
188 I BUFF'="" D BUFF^IBCNEUT2(BUFF,10)
189 Q
Note: See TracBrowser for help on using the repository browser.