source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSECMPS.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1BPSECMPS ;BHAM ISC/FCS/DRS - Parse Claim Response ;06/15/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5PARSE(RREC,CLAIMIEN,RESPIEN) ;
6 N GS,FS,SS,FILE,ROOT,TRANSACT,TRANSCNT
7 N FDATA,FDAIEN,FDAIEN03
8 ;
9 ;Make sure input variables are defined
10 Q:$G(RREC)=""
11 Q:$G(CLAIMIEN)=""
12 ;
13 ;group and field separator characters
14 S GS="\X1D\",FS="\X1C\",SS="\X1E\"
15 S FILE="9002313.03"
16 S ROOT="FDATA(9002313.03)"
17 D TRANSMSN ;process the transmission level data
18 D TRANSACT ;process the transaction level data
19 ;
20 ; If the test payer routine exists, call the override routine
21 ; IEN59 and TRANTYPE are set in BPSECMC2
22 ; Commented for production. MUST be commented out for any release.
23 ;I $L($T(CHECK^ZZGIZOV1))>0,$$CHECK^ZZGIZOV1 D SETOVER^ZZGIZOV1(IEN59,TRANTYPE,.FDATA)
24 D UPDATE^DIE("S","FDATA(9002313.03)","FDAIEN")
25 F TRANSACT=1:1:TRANSCNT D
26 .D PROCRESP
27 .D PROCREJ
28 .D PROCAPP
29 .D PROCPPR
30 .D PROCOTH^BPSECMP2
31 .D PROCDUR^BPSECMP2
32 .S RESPIEN=FDAIEN(TRANSACT)
33 .D IBSEND^BPSECMP2(CLAIMIEN,RESPIEN,"","")
34 Q
35 ;
36TRANSMSN ;This subroutine will work through the transmission level information
37 ;
38 N RTRANM,RHEADER,SEG,SEGMENT,SEGID
39 ;
40 ;Parse response transmission level from ascii record
41 S RTRANM=$P(RREC,GS,1)
42 ;
43 ; get just the header segment
44 S RHEADER=$P(RTRANM,SS,1) ;header- required/fixed length
45 D PARSEH
46 ;
47 ; There are 2 optional segments on the transmission level - message
48 ; and insurance. We'll check for both and parse what we find.
49 F SEG=2:1:3 D
50 . S SEGMENT=$P(RTRANM,SS,SEG)
51 . Q:SEGMENT=""
52 . S SEGID=$P(SEGMENT,FS,2)
53 . I $E(SEGID,1,2)="AM" D ;segment identification
54 .. S SEGFID=$E(SEGID,3,4)
55 .. D:(SEGFID=20)!(SEGFID=25) PARSETM
56 ;
57 Q
58 ;
59TRANSACT ;This subroutine will work through the transaction level information
60 ;
61 N RTRAN,SEG,SEGMENT,MEDN,GRP
62 S MEDN=0
63 ;
64 F GRP=2:1 D Q:RTRAN=""
65 . S RTRAN=$P(RREC,GS,GRP) ;get the next transaction (could be 4)
66 . Q:RTRAN="" ;we're done if it's empty
67 . S MEDN=MEDN+1 ;transaction counter
68 . ;
69 . F SEG=2:1 D Q:SEGMENT="" ;break the record down by segments
70 .. S SEGMENT=$P(RTRAN,SS,SEG) ;get the segment
71 .. Q:SEGMENT=""
72 .. D PARSETN ;get the fields
73 Q
74 ;
75PARSEH ; The header record is required on all responses, and is fixed
76 ; length. It is the only record that is fixed length.
77 ;
78 N FIELD,%,%H,%I
79 S FIELD=".01" D FDA^DILF(FILE,"+1",FIELD,"",CLAIMIEN,ROOT)
80 D NOW^%DTC
81 S FIELD=".02" D FDA^DILF(FILE,"+1",FIELD,"",%,ROOT)
82 S FIELD=".03" D FDA^DILF(FILE,"+1",FIELD,"",$H,ROOT)
83 S FIELD=102 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,33,34),ROOT) ;version/release number
84 S FIELD=103 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,35,36),ROOT) ;transaction code
85 S FIELD=109 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,37,37),ROOT) ;transaction count
86 S TRANSCNT=$E(RHEADER,37,37)
87 S FIELD=501 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,38,38),ROOT) ;response status header
88 S FIELD=202 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,39,40),ROOT) ;service provider id qualifier
89 S FIELD=201 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,41,55),ROOT) ;service provider id
90 S FIELD=401 D FDA^DILF(FILE,"+1",FIELD,"",$E(RHEADER,56,63),ROOT) ;date of service
91 Q
92 ;
93PARSETM ; This subroutine will parse the variable portions of the transmission
94 ;
95 N FIELD,PC,FLDNUM
96 ;
97 F PC=3:1 D Q:FIELD="" ;skip the seg id -already know its value
98 . S FIELD=$P(SEGMENT,FS,PC) ;piece through the record
99 . Q:FIELD="" ;stop - we hit the end
100 . S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage
101 . Q:FLDNUM="" ;shouldn't happen - but lets skip
102 . S FIELD=$E(FIELD,3,999)
103 . D FDA^DILF(FILE,"+1",FLDNUM,"",FIELD,ROOT)
104 Q
105 ;
106PARSETN ; This subroutine will parse the transaction level segments. For
107 ;
108 ; Possible values of the SEGFID field:
109 ; 21 = Response Status Segment
110 ; 22 = Response Claim Segment
111 ; 23 = Response Pricing Segment
112 ; 24 = Response DUR/PPS Segment
113 ; 26 = Response Prior Authorization Segment
114 ;
115 N FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT
116 N SEGID,SEGFID,CKRPT
117 ;
118 S RPTFLD=""
119 S SEGID=$P(SEGMENT,FS,2) ;this should be the segment id
120 Q:SEGID="" ;don't process without a Seg id
121 Q:$E(SEGID,1,2)'="AM" ;don't know what we have - skip
122 ;
123 S SEGFID=$E(SEGID,3,4) ;this should be the field ID
124 ;
125 ; setup the repeating flds based on the segment
126 I SEGFID=21 D ;status segment
127 . S RPTFLD=",548,511,546,"
128 . S (RCNT(548),RCNT(511),RCNT(546))=0
129 ;
130 I SEGFID=22 D ;claim segment
131 . S RPTFLD=",552,553,554,555,556,"
132 . S (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0
133 ;
134 I SEGFID=23 D ;pricing segment
135 . S RPTFLD=",564,565,"
136 . S (RCNT(564),RCNT(565))=0
137 ;
138 I SEGFID=24 D ;DUR/PPS segment
139 . S RPTFLD=",439,528,529,530,531,532,533,9002313,544,567,"
140 . S (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0
141 . S (RCNT(532),RCNT(533),RCNT(9002313),RCNT(567))=0,RCNT(544)=0
142 ;
143 ; now lets parse out the fields
144 ;
145 F PC=3:1 D Q:FIELD="" ;skip the seg id -jump to the other flds
146 . S FIELD=$P(SEGMENT,FS,PC) ;piece through the record
147 . Q:FIELD="" ;stop - we hit the end
148 . S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage
149 . Q:FLDNUM="" ;shouldn't happen - but lets skip
150 . S REPEAT=0 ;for this segment, lets figure
151 . S CKRPT=","_FLDNUM_"," ;out if the field is a repeating
152 . S:RPTFLD[CKRPT REPEAT=1 ;field
153 . ;
154 . I REPEAT D ;if rptg, store with a counter
155 .. S RCNT(FLDNUM)=$G(RCNT(FLDNUM))+1
156 .. S FDATA(MEDN,FLDNUM,RCNT(FLDNUM))=$E(FIELD,3,$L(FIELD))
157 . ;
158 . I 'REPEAT D ;not rptg, store without counter
159 .. S FDATA(MEDN,FLDNUM)=$E(FIELD,3,$L(FIELD))
160 Q
161 ;
162GETNUM(FIELD) ; This routine will translate the field ID into a field number.
163 ; We will use the NCPDP field Defs files, cross ref "D" to
164 ; perform this translation. (The field number is needed to store
165 ; the data in the correct field within the response file.)
166 ;
167 N FLDID,FLDIEN,FLDNUM
168 S (FLDID,FLDNUM)=""
169 S FLDIEN=0
170 ;
171 S FLDID=$E(FIELD,1,2) ;field identifier
172 Q:FLDID=""
173 ;
174 I FLDID'="" D
175 . S FLDIEN=$O(^BPSF(9002313.91,"D",FLDID,FLDIEN)) ;internal fld #
176 . S:FLDIEN FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,0)),U) ;fld number
177 Q FLDNUM
178 ;
179PROCRESP ;
180 N FILE,ROOT,FDATA03,FLDNUM,FIELD
181 S FILE="9002313.0301"
182 S ROOT="FDATA03(9002313.0301)"
183 K FDATA03
184 I '$D(FDATA(TRANSACT,501)) S FDATA(TRANSACT,501)=FDATA(TRANSACT,112)
185 I '$D(FDATA(TRANSACT,112)) S FDATA(TRANSACT,112)=FDATA(TRANSACT,501)
186 S FLDNUM=".01" D FDA^DILF(FILE,"+1,"_FDAIEN(TRANSACT),FLDNUM,"",TRANSACT,ROOT)
187 S FIELD=""
188 F S FIELD=$O(FDATA(TRANSACT,FIELD)) Q:FIELD="" D ;set all the non-repeating fields for 9002313.0301
189 .I $G(FDATA(TRANSACT,FIELD))'="" D
190 ..I FIELD=402 S FDATA(TRANSACT,FIELD)=$TR(FDATA(TRANSACT,FIELD),"\","") ;REMOVE EXTRANEOUS "\"
191 ..D FDA^DILF(FILE,"+"_TRANSACT_","_FDAIEN(TRANSACT),FIELD,"",FDATA(TRANSACT,FIELD),ROOT)
192 .E D
193 ..;
194 D UPDATE^DIE("S","FDATA03(9002313.0301)","FDAIEN03")
195 Q
196 ;
197PROCREJ ;
198 Q:$G(FDATA(TRANSACT,510))=""
199 N FILE,ROOT,FLDNUM,FDAT3511,NUMREJS,NNDX
200 S FILE="9002313.03511"
201 S ROOT="FDAT3511(9002313.03511)"
202 S NUMREJS=FDATA(TRANSACT,510)
203 S NNDX=""
204 F S NNDX=$O(FDATA(TRANSACT,511,NNDX)) Q:NNDX="" D ;set all the non-repeating fields for 9002313.3511 rejections
205 .S FDATA(TRANSACT,511,NNDX)=$TR(FDATA(TRANSACT,511,NNDX),"\","")
206 .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,511,NNDX),ROOT)
207 D UPDATE^DIE("S","FDAT3511(9002313.03511)")
208 Q
209 ;
210PROCAPP ;
211 Q:$G(FDATA(TRANSACT,548,1))=""
212 N FILE,ROOT,FLDNUM,FDAT1548,NNDX
213 S FILE="9002313.301548"
214 S ROOT="FDAT1548(9002313.0301548)"
215 S NNDX=""
216 F S NNDX=$O(FDATA(FDAIEN(TRANSACT),548,NNDX)) Q:NNDX="" D
217 .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,548,NNDX),ROOT)
218 D UPDATE^DIE("S","FDAT1548(9002313.301548)")
219 Q
220 ;
221PROCPPR ;
222 Q:$G(FDATA(TRANSACT,551.01,1))=""
223 N FILE,ROOT,FLDNUM,FDAT1301,NNDX
224 S FILE="9002313.1301"
225 S ROOT="FDAT1301(9002313.1301)"
226 S NNDX=""
227 F S NNDX=$O(FDATA(FDAIEN(TRANSACT),551.01,NNDX)) Q:NNDX="" D
228 .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,551.01,NNDX),ROOT)
229 D UPDATE^DIE("S","FDAT1301(9002313.1301)")
230 Q
Note: See TracBrowser for help on using the repository browser.