source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCE277.m@ 812

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1IBCE277 ;ALB/TMP - 277 EDI CLAIM STATUS MESSAGE PROCESSING ;15-JUL-98
2 ;;2.0;INTEGRATED BILLING;**137,155,368**;21-MAR-94;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ; MESSAGE HEADER DATA STRING =
6 ; type of message^msg queue^msg #^bill #^REF NUM/Batch #^date/time
7 ;
8HDR(ENTITY,ENTVAL,IBTYPE,IBD) ;Process header data
9 ; INPUT:
10 ; ENTITY = "BATCH" or "CLAIM" for batch/claim level messages respectively
11 ; ENTVAL = claim #
12 ; IBTYPE = the type of status msg this piece of the message represents
13 ; (837REC1, 837REJ1)
14 ; ^TMP("IBMSGH",$J,0) = header message text
15 ;
16 ; OUTPUT:
17 ; IBD array returned with processed data
18 ; "DATE" = Date/Time of status (Fileman format)
19 ; "MRA" = 1 if MRA, 0 if not "X12" = 1 if X12, 0 if not
20 ; "BATCH" = Batch ien for batch level calls
21 ; "SOURCE" = Source of message code^source name, if known
22 ;
23 ; ^TMP("IBMSG",$J,"BATCH",batch #,0)=MESSAGE HEADER DATA STRING
24 ; if batch level message
25 ; ,"D",0,1)=header record raw data
26 ; ,line #)=batch status message lines
27 ;
28 ; ^TMP("IBMSG",$J,"CLAIM",claim #,0)=MESSAGE HEADER DATA STRING
29 ; if claim level message
30 ; ,"D",0,1)=header record raw data
31 ; ,line #)=claim status message lines
32 ;
33 N DATA,IBD0,L,PC,X,Y
34 S IBD0=$G(^TMP("IBMSGH",$J,0)) Q:IBD0=""
35 S Y=0,L=1
36 ; Convert claim date/time
37 S X=$$DATE($P(IBD0,U,3))_"@"_$E($P(IBD0,U,4)_"0000",1,4) I X S %DT="XTS" D ^%DT
38 ; populate IBD array
39 S IBD("DATE")=$S(Y>0:Y,1:""),IBD("MRA")=$P(IBD0,U,5),IBD("X12")=($P(IBD0,U,2)="X")
40 S IBD("SOURCE")=$P(IBD0,U,12,13),IBD("BATCH")=$P(IBD0,U,14)
41 I +$TR($P(IBD0,U,6,9),U) F PC=6:1:9 D
42 .I $P(IBD0,U,PC)'="" S DATA=$P("# Claims Submitted^# Claims Rejected^Total Charges Submitted^Total Charges Rejected",U,PC-5)_": "_$S(PC<8:+$P(IBD0,U,PC),1:$FNUMBER($P(IBD0,U,PC)/100,"",2))_" "
43 .I $L($G(^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)))+$L(DATA)>70 S L=L+1 ; if data doesn't fit into current line, go to the next line
44 .S ^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)=$G(^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L))_DATA ; file this piece of data
45 .Q
46 ; file batch ref. number
47 S:IBD("BATCH")'="" L=L+1,^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)="Batch Reference Number: "_IBD("BATCH")
48 I $TR($P(IBD0,U,10,13),U)'="" D
49 .S L=L+1
50 .; generate and file Payer Name / Payer Id line
51 .S DATA="Payer Name: "_$S($P(IBD0,U,10)'="":$P(IBD0,U,10),1:"N/A")_" Payer ID: "_$S($P(IBD0,U,11)'="":$P(IBD0,U,11),1:"N/A")
52 .S ^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)=DATA
53 .I $P(IBD0,U,12)'=""!($P(IBD0,U,13)'="") D
54 ..; generate and file Message Source line
55 ..S DATA="Source: "_$S($P(IBD0,U,12)="Y":"Sent by payer",$P(IBD0,U,13)'="":"Sent by non-payer ("_$P(IBD0,U,13)_")",1:"UNKNOWN")
56 ..S L=L+1,^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)=DATA
57 ..Q
58 .Q
59 S ^TMP("IBMSG",$J,ENTITY,ENTVAL,0)=IBTYPE_U_$G(IBD("MSG#"))_U_$G(IBD("SUBJ"))_U_$$GETBILL(ENTVAL)_U_U_IBD("DATE")_U_IBD("SOURCE")
60 ; file raw data
61 S ^TMP("IBMSG",$J,ENTITY,ENTVAL,"D",0,1)="##RAW DATA: "_IBD0
62 Q
63 ;
649(IBD) ; Process Message Header record
65 ; INPUT:
66 ; IBD must be passed by reference = entire message line
67 ; OUTPUT:
68 ; IBD array returned with processed data
69 ; "CLAIM" = claim #
70 ; "LINE" = last line # populated in the message
71 ;
72 ; ^TMP("IBMSG",$J,"CLAIM",claim #,line#)= message data lines
73 ; ,"D",9,msg seq #)= raw data
74 N ENTITY,ERR,FLD,IBCLM,IBIFN,L
75 D STRTREC Q:IBCLM="" ; if no claim/batch number, bail out
76 ; make sure that we have data to file
77 S ERR=$P(IBD,U,4) Q:ERR=""
78 ; file error along with corresponding field number (if available)
79 S L=L+1,FLD=$P(IBD,U,5),^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Error"_$S(FLD'="":" in field "_FLD,1:"")_":"
80 S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=ERR
81 D ENDREC(9)
82 Q
83 ;
8410(IBD) ; Process message data
85 ; INPUT:
86 ; IBD must be passed by reference = entire message line
87 ; OUTPUT:
88 ; IBD array returned with processed data
89 ; "CLAIM" = claim #
90 ; "LINE" = last line # populated in the message
91 ;
92 ; ^TMP("IBMSG",$J,"CLAIM",claim #,line#)= message data lines
93 ; ,"D",10,msg seq #)= raw data
94 ; ^TMP("IBCONF",$J,claim #")="" for invalid claims within the batch
95 ;
96 N CODE,DATA,ENTITY,IBCLM,IBIFN,IBTYPE,L,Z
97 D STRTREC Q:IBCLM="" ; if no claim number, bail out
98 S:$P(IBD,U,3)="R" ^TMP("IBCONF",$J,IBIFN)=""
99 S IBTYPE=$S($P(IBD,U,3)="R":"837REJ1",1:"837REC1")
100 ;Process header data if not already done
101 I '$D(^TMP("IBMSG",$J,ENTITY,IBCLM,0)) D HDR(ENTITY,IBCLM,IBTYPE,.IBD)
102 I IBTYPE="837REJ1",$P($G(^TMP("IBMSG",$J,ENTITY,IBCLM,0)),U,1)'="837REJ1" D HDR(ENTITY,IBCLM,IBTYPE,.IBD)
103 S CODE=$P(IBD,U,4) I CODE'="",$TR($P(IBD,U,5,6),U)'="" D
104 .S Z=CODE_$P(IBD,U,5) I Z'=$G(IBD("SCODE")) D
105 ..; determine type of status code and file it
106 ..S L=L+1,DATA=$S(CODE="W":"Warning",CODE="E":"Error",1:"Informational")_" "
107 ..I $P(IBD,U,5)'="" S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)=DATA_"Code: "_$P(IBD,U,5)
108 ..I $P(IBD,U,6)'="" S:$P(IBD,U,5)'="" L=L+1 S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)=DATA_"Message:",L=L+1
109 ..S IBD("SCODE")=Z
110 ..Q
111 .; file status message
112 .I $P(IBD,U,6)'="" S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)=$P(IBD,U,6),L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=" "
113 .Q
114 D ENDREC(10)
115 Q
116 ;
11713(IBD) ; Process claim data
118 ; Claim must have been referenced by a previous '10' level
119 ; INPUT:
120 ; IBD must be passed by reference = entire message line
121 ;
122 ; OUTPUT:
123 ; IBD("LINE") = The last line # populated in the message
124 ;
125 ; ^TMP("IBMSG",$J,"CLAIM",claim #,line#)=claim data lines
126 ; ,"D",13,msg seq #)=raw data
127 ;
128 N CTYPE,ENTITY,IBCLM,IBIFN,L,Z1,Z2
129 D STRTREC
130 ; quit if no claim number or no previous 'line 10' record
131 Q:$S(IBCLM="":1,1:'$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)))
132 ; file clearinghouse trace number
133 I $P(IBD,U,3)'="" S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Clearinghouse Trace Number: "_$P(IBD,U,3)
134 ; file payer status date
135 I $P(IBD,U,4)'="" S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=" Payer Status Date: "_$$DATE($P(IBD,U,4))
136 ; file payer claim number
137 I $P(IBD,U,5)'="" S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=" Payer Claim Number: "_$P(IBD,U,5)
138 ; file split claim indicator
139 I +$P(IBD,U,6)'=0 S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=" Split Claim: "_$S(+$P(IBD,U,6)=1:"No",1:"Yes ("_+$P(IBD,U,6)_" parts)")
140 ; file claim type if it either doesn't match value in VistA or if it's a dental claim
141 S Z1=$P(IBD,U,7),Z2=$$FT^IBCEF(IBIFN),CTYPE=$S(Z1="P"&(Z2'=2):"Professional",Z1="I"&(Z2'=3):"Institutional",Z1="D":"Dental",1:"")
142 S:CTYPE'="" L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=" Claim Type: "_CTYPE
143 D ENDREC(13)
144 Q
145 ;
14615(IBD) ; Process subscriber/patient data
147 ; Claim must have been referenced by a previous '10' level
148 ; INPUT:
149 ; IBD must be passed by reference = entire message line
150 ;
151 ; OUTPUT:
152 ; IBD("LINE") = The last line # populated in the message
153 ;
154 ; ^TMP("IBMSG",$J,"CLAIM",claim #,line#)=formatted service dates
155 ; ,"D",15,msg seq #)=
156 ; subscr/patient raw data
157 ;
158 N ENTITY,DATA,IBCLM,IBIFN,IBNM,IBNUM,IBDFN,L
159 D STRTREC
160 ; quit if no claim number or no previous 'line 10' record
161 Q:$S(IBCLM="":1,1:'$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)))
162 S IBDFN=+$P(^DGCR(399,IBIFN,0),U,2)
163 S IBNM=$S($P(IBD,U,3)'="":$P(IBD,U,3)_","_$P(IBD,U,4)_$S($P(IBD,U,5)'="":" "_$P(IBD,U,5),1:""),1:$P($G(^DPT(IBDFN,0)),U))
164 S IBNUM=$S($P(IBD,U,6)'="":$P(IBD,U,6),1:$P($G(^DPT(IBDFN,0)),U,9))
165 S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Patient: "_IBNM_" "_IBNUM
166 I $P(IBD,U,11) D
167 .S DATA=$$DATE($P(IBD,U,11)),L=L+1
168 .S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Service Dates: "_DATA_" - "_$S($P(IBD,U,12):$$DATE($P(IBD,U,12)),1:DATA)
169 .Q
170 D ENDREC(15)
171 Q
172 ;
173STRTREC ; start processing of the record
174 ;
175 ; OUTPUT:
176 ; sets the following variables
177 ; IBCLM = claim #
178 ; ENTITY = "CLAIM" (all 277STAT messages are on claim level)
179 ; L = last populated line number
180 ;
181 S IBCLM=$$GETCLM($P(IBD,U,2)),ENTITY="CLAIM",L=+$G(IBD("LINE"))
182 S IBIFN=+$O(^DGCR(399,"B",IBCLM,0))
183 Q
184 ;
185ENDREC(TYPE) ; finish processing of the record
186 ; INPUT:
187 ; TYPE = record type (line type)
188 ;
189 ; OUTPUT:
190 ; IBD("LINE") = is updated with last populated line number
191 ;
192 ;make sure all variables are set properly
193 Q:$G(ENTITY)=""
194 Q:$G(IBCLM)=""
195 Q:$G(TYPE)=""
196 ; file raw data
197 S ^TMP("IBMSG",$J,ENTITY,IBCLM,"D",TYPE,$O(^TMP("IBMSG",$J,ENTITY,IBCLM,"D",TYPE,""),-1)+1)="##RAW DATA: "_IBD
198 ; update line count
199 S IBD("LINE")=$G(IBD("LINE"))+L
200 Q
201 ;
202GETBILL(CLAIM) ; Extract transmission #
203 N TRANS
204 S TRANS=$$LAST364^IBCEF4(IBIFN)
205 ; if status of the last transmission is "X" or "P", keep searching backwards through file 364 until record
206 ; with different status is found
207 I TRANS F Q:"XP"'[$P(^IBA(364,TRANS,0),U,3) S TRANS=$O(^IBA(364,"B",IBIFN,TRANS),-1) Q:TRANS="" ;
208 Q +TRANS
209 ;
210DATE(DT) ; Convert YYMMDD Date into MM/DD/YY or YYYYMMDD into MM/DD/YYYY
211 N D,Y
212 S D=DT,Y=""
213 I $L(DT)=8 S D=$E(DT,3,8),Y=$E(DT,1,2)
214 Q ($E(D,3,4)_"/"_$E(D,5,6)_"/"_Y_$E(D,1,2))
215 ;
216GETCLM(X) ; Extract the claim # without site id from the data in X
217 N IBCLM
218 S IBCLM=$P(X,"-",2) I IBCLM="",X'="" S IBCLM=$E(X,$S($L(X)>7:4,1:1),$L(X))
219 Q IBCLM
220 ;
Note: See TracBrowser for help on using the repository browser.