ABSPDR ; IHS/OIT/CASSEVER/RAN - Parse Claim D.0 Response ; [ 03/04/2011 12:56 PM ]
;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001 Copied from ABSPOSH4 for 5.1 claims and modified;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Parse ASCII Response Claim Record and Sup FDATA() Array
;
;Parameters: RREC - Ascii Response Record
; RESPIEN - Claim Response IEN (90023130.3)
;----------------------------------------------------------------------
;
;----------------------------------------------------------------------
;
; This routine will be solely responsible for parsing the data
; for D.0 B1 Claims responses and E1 Eligibility responses It is called by ABSPECA4.
;----------------------------------------------------------------------
;
;----------------------------------------------------------------------
PARSEE1(RREC,E1IEN,DEBUG) ;EP - from ABSPECA4
N GS,FS,SS
;
;Make sure input varaibles are defined
Q:$G(RREC)=""
Q:$G(E1IEN)=""
Q:'$D(^ABSPE(E1IEN,0))
;
;group and field separator characters
S GS=$C(29),FS=$C(28),SS=$C(30)
;
D TRANSMSN ;process the transmission level data
D TRANSACT ;process the transaction level data
;
Q
;
PARSEB1(RREC,RESPIEN,DEBUG) ;EP - from ABSPECA4
N GS,FS,SS
;
;Make sure input variables are defined
Q:$G(RREC)=""
Q:$G(RESPIEN)=""
Q:'$D(^ABSPR(RESPIEN,0))
;
;group and field separator characters
S GS=$C(29),FS=$C(28),SS=$C(30)
;
D TRANSMSN ;process the transmission level data
D TRANSACT ;process the transaction level data
;We don't want to actually save any of this stuff while were testing the parser
I '$G(DEBUG) D FILE^ABSPOSH5(RESPIEN) ;add information to the response file
;
Q
;
;
TRANSMSN ;This subroutine will work through the transmission level information
;
N RTRANM,RHEADER,SEG,SEGMENT,SEGID
;
;Parse response transmission level from ascii record
S RTRANM=$P(RREC,GS,1)
;
; get just the header segment
S RHEADER=$P(RTRANM,SS,1) ;header- required/fixed length
D PARSEH
;
; There are 2 optional segments on the trasmission level - message
; and insurance. We'll check for both and parse what we find.
;
F SEG=2:1:3 D
. S SEGMENT=$P(RTRANM,SS,SEG)
. Q:SEGMENT=""
. S SEGID=$P(SEGMENT,FS,2)
. I $E(SEGID,1,2)="AM" D ;segment identification
. D:($E(SEGID,3,4)=20)!($E(SEGID,3,4)=25) PARSETM
;
Q
;
TRANSACT ;This subroutine will work through the transaction level information
;
N RTRAN,SEG,SEGMENT,MEDN
S MEDN=0
;
F GRP=2:1 D Q:RTRAN=""
. S RTRAN=$P(RREC,GS,GRP) ;get the next transaction (could be 4)
. Q:RTRAN="" ;we're done if it's empty
. S MEDN=MEDN+1 ;transaction counter
. ;
. F SEG=2:1 D Q:SEGMENT="" ;break the record down by segments
.. S SEGMENT=$P(RTRAN,SS,SEG) ;get the segment
.. Q:SEGMENT=""
.. D PARSETN ;get the fields
;
;
Q
;
;
PARSEH ; The header record is required on all responses, and is fixed
; length. It is the only record that is fixed length.
;
S FDATA(102)=$E(RHEADER,1,2) ;version/release number
S FDATA(103)=$E(RHEADER,3,4) ;transaction code
S FDATA(109)=$E(RHEADER,5,5) ;transaction count
S FDATA(501)=$E(RHEADER,6,6) ;header response status
S FDATA(202)=$E(RHEADER,7,8) ;service provider id qualifier
S FDATA(201)=$E(RHEADER,9,23) ;service provider id
S FDATA(401)=$E(RHEADER,24,31) ;date of service
;
Q
;
PARSETM ; This subroutine will parse the variable portions of the transmission
; level message. Keep in mind that most fields are optional
; so we have no idea what is coming back. We will parse based
; on the field separators, and field identification.
; (tranmission level variable records are the message (ID=20)
; and insurance (ID=25) segments)
;
N FIELD,PC,FLDNUM
;
F PC=3:1 D Q:FIELD="" ;skip the seg id -already know its value
. S FIELD=$P(SEGMENT,FS,PC) ;piece through the record
. Q:FIELD="" ;stop - we hit the end
. S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage
. Q:FLDNUM="" ;shouldn't happen - but lets skip
. S FDATA(FLDNUM)=$E(FIELD,3,$L(FIELD)) ;hold the value
;
Q
;
PARSETN ; This subroutine will parse the transaction level segments. For
; most transactions, the only segment required in this area of
; the response is the status segment. However, since we aren't
; sure what we will be getting back, we will process whatever
; is sent our way.
;
; Please note that most fields are optional, so we will parse the
; record based on field separators and the value of the field
; identification.
; Also please note that several of the segments have repeating
; fields - we will determine which fields are repeating, based
; on the segment identification.
;
; Possible values of the SEGFID field:
; 21 = Response Status Segment
; 22 = Response Claim Segment
; 23 = Response Pricing Segment
; 24 = Response DUR/PPS Segment
; 26 = Repsonse Prior Authorization Segment
; 28 = Response COB (New to D.0)
; 29 = Response Patient Segment (New to D.0)
;
N FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT
;
S RPTFLD=""
S SEGID=$P(SEGMENT,FS,2) ;this should be the segment id
Q:SEGID="" ;don't process without a Seg id
Q:$E(SEGID,1,2)'="AM" ;don't know what we have - skip
;
S SEGFID=$E(SEGID,3,4) ;this should be the field ID
;
; setup the repeating flds based on the segment (526 was changed to a repeating field in D.0)
I SEGFID=21 D ;status segment
. S RPTFLD=",526,548,511,546,"
. S (RCNT(548),RCNT(511),RCNT(546),RCNT(526))=0
;
I SEGFID=22 D ;claim segment
. S RPTFLD=",552,553,554,555,556,"
. S (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0
;
I SEGFID=23 D ;pricing segment
. S RPTFLD=",564,565,"
. S (RCNT(564),RCNT(565))=0
;
I SEGFID=24 D ;DUR/PPS segment
. S RPTFLD=",439,528,529,530,531,532,533,544,567,"
. S (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0
. S (RCNT(532),RCNT(533),RCNT(544),RCNT(567))=0
;
; now lets parse out the fields
;
F PC=3:1 D Q:FIELD="" ;skip the seg id -jump to the other flds
. S FIELD=$P(SEGMENT,FS,PC) ;piece through the record
. Q:FIELD="" ;stop - we hit the end
. S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage
. ;IHS/OIT/SCR 11/26/08 - next line avoids subscript error on last line of routine
. ;EMERGENCY FIX distributed on 12/2/08 -added to patch 36 011910
. Q:FLDNUM=""
. S REPEAT=0 ;for this segment, lets figure
. S CKRPT=","_FLDNUM_"," ;out if the field is a repeating
. S:RPTFLD[CKRPT REPEAT=1 ;field
. ;
. I REPEAT D ;if rptg, store with a counter
.. S RCNT(FLDNUM)=$G(RCNT(FLDNUM))+1
.. S FDATA("M",MEDN,FLDNUM,RCNT(FLDNUM))=$E(FIELD,3,$L(FIELD))
. ;
. I 'REPEAT D ;not rptg, store without counter
.. S FDATA("M",MEDN,FLDNUM)=$E(FIELD,3,$L(FIELD))
;
;
Q
;
GETNUM(FIELD) ; This routine will translate the field ID into a field number.
; We will use the ABSP NCPDP field Defs files, corss ref "D" to
; perform this translation. (The field number is needed to store
; the data in the correct field within the response file.)
;
N FLDID,FLDIEN,FLDNUM
S (FLDID,FLDNUM)=""
S FLDIEN=0
;
S FLDID=$E(FIELD,1,2) ;field identifier
Q:FLDID=""
;
I FLDID'="" D
. S FLDIEN=$O(^ABSPF(9002313.91,"D",FLDID,FLDIEN)) ;internal fld #
. S:FLDIEN FLDNUM=$P($G(^ABSPF(9002313.91,FLDIEN,0)),U) ;fld number
;
;
Q FLDNUM
;
ABSPDR ; IHS/OIT/CASSEVER/RAN - Parse Claim D.0 Response ; [ 03/04/2011 12:56 PM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001 Copied from ABSPOSH4 for 5.1 claims and modified;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;Parse ASCII Response Claim Record and Sup FDATA() Array
+5 ;
+6 ;Parameters: RREC - Ascii Response Record
+7 ; RESPIEN - Claim Response IEN (90023130.3)
+8 ;----------------------------------------------------------------------
+9 ;
+10 ;----------------------------------------------------------------------
+11 ;
+12 ; This routine will be solely responsible for parsing the data
+13 ; for D.0 B1 Claims responses and E1 Eligibility responses It is called by ABSPECA4.
+14 ;----------------------------------------------------------------------
+15 ;
+16 ;----------------------------------------------------------------------
PARSEE1(RREC,E1IEN,DEBUG) ;EP - from ABSPECA4
+1 NEW GS,FS,SS
+2 ;
+3 ;Make sure input varaibles are defined
+4 IF $GET(RREC)=""
QUIT
+5 IF $GET(E1IEN)=""
QUIT
+6 IF '$DATA(^ABSPE(E1IEN,0))
QUIT
+7 ;
+8 ;group and field separator characters
+9 SET GS=$CHAR(29)
SET FS=$CHAR(28)
SET SS=$CHAR(30)
+10 ;
+11 ;process the transmission level data
DO TRANSMSN
+12 ;process the transaction level data
DO TRANSACT
+13 ;
+14 QUIT
+15 ;
PARSEB1(RREC,RESPIEN,DEBUG) ;EP - from ABSPECA4
+1 NEW GS,FS,SS
+2 ;
+3 ;Make sure input variables are defined
+4 IF $GET(RREC)=""
QUIT
+5 IF $GET(RESPIEN)=""
QUIT
+6 IF '$DATA(^ABSPR(RESPIEN,0))
QUIT
+7 ;
+8 ;group and field separator characters
+9 SET GS=$CHAR(29)
SET FS=$CHAR(28)
SET SS=$CHAR(30)
+10 ;
+11 ;process the transmission level data
DO TRANSMSN
+12 ;process the transaction level data
DO TRANSACT
+13 ;We don't want to actually save any of this stuff while were testing the parser
+14 ;add information to the response file
IF '$GET(DEBUG)
DO FILE^ABSPOSH5(RESPIEN)
+15 ;
+16 QUIT
+17 ;
+18 ;
TRANSMSN ;This subroutine will work through the transmission level information
+1 ;
+2 NEW RTRANM,RHEADER,SEG,SEGMENT,SEGID
+3 ;
+4 ;Parse response transmission level from ascii record
+5 SET RTRANM=$PIECE(RREC,GS,1)
+6 ;
+7 ; get just the header segment
+8 ;header- required/fixed length
SET RHEADER=$PIECE(RTRANM,SS,1)
+9 DO PARSEH
+10 ;
+11 ; There are 2 optional segments on the trasmission level - message
+12 ; and insurance. We'll check for both and parse what we find.
+13 ;
+14 FOR SEG=2:1:3
Begin DoDot:1
+15 SET SEGMENT=$PIECE(RTRANM,SS,SEG)
+16 IF SEGMENT=""
QUIT
+17 SET SEGID=$PIECE(SEGMENT,FS,2)
+18 ;segment identification
IF $EXTRACT(SEGID,1,2)="AM"
Begin DoDot:2
End DoDot:2
+19 IF ($EXTRACT(SEGID,3,4)=20)!($EXTRACT(SEGID,3,4)=25)
DO PARSETM
End DoDot:1
+20 ;
+21 QUIT
+22 ;
TRANSACT ;This subroutine will work through the transaction level information
+1 ;
+2 NEW RTRAN,SEG,SEGMENT,MEDN
+3 SET MEDN=0
+4 ;
+5 FOR GRP=2:1
Begin DoDot:1
+6 ;get the next transaction (could be 4)
SET RTRAN=$PIECE(RREC,GS,GRP)
+7 ;we're done if it's empty
IF RTRAN=""
QUIT
+8 ;transaction counter
SET MEDN=MEDN+1
+9 ;
+10 ;break the record down by segments
FOR SEG=2:1
Begin DoDot:2
+11 ;get the segment
SET SEGMENT=$PIECE(RTRAN,SS,SEG)
+12 IF SEGMENT=""
QUIT
+13 ;get the fields
DO PARSETN
End DoDot:2
IF SEGMENT=""
QUIT
End DoDot:1
IF RTRAN=""
QUIT
+14 ;
+15 ;
+16 QUIT
+17 ;
+18 ;
PARSEH ; The header record is required on all responses, and is fixed
+1 ; length. It is the only record that is fixed length.
+2 ;
+3 ;version/release number
SET FDATA(102)=$EXTRACT(RHEADER,1,2)
+4 ;transaction code
SET FDATA(103)=$EXTRACT(RHEADER,3,4)
+5 ;transaction count
SET FDATA(109)=$EXTRACT(RHEADER,5,5)
+6 ;header response status
SET FDATA(501)=$EXTRACT(RHEADER,6,6)
+7 ;service provider id qualifier
SET FDATA(202)=$EXTRACT(RHEADER,7,8)
+8 ;service provider id
SET FDATA(201)=$EXTRACT(RHEADER,9,23)
+9 ;date of service
SET FDATA(401)=$EXTRACT(RHEADER,24,31)
+10 ;
+11 QUIT
+12 ;
PARSETM ; This subroutine will parse the variable portions of the transmission
+1 ; level message. Keep in mind that most fields are optional
+2 ; so we have no idea what is coming back. We will parse based
+3 ; on the field separators, and field identification.
+4 ; (tranmission level variable records are the message (ID=20)
+5 ; and insurance (ID=25) segments)
+6 ;
+7 NEW FIELD,PC,FLDNUM
+8 ;
+9 ;skip the seg id -already know its value
FOR PC=3:1
Begin DoDot:1
+10 ;piece through the record
SET FIELD=$PIECE(SEGMENT,FS,PC)
+11 ;stop - we hit the end
IF FIELD=""
QUIT
+12 ;get the field number used for storage
SET FLDNUM=$$GETNUM(FIELD)
+13 ;shouldn't happen - but lets skip
IF FLDNUM=""
QUIT
+14 ;hold the value
SET FDATA(FLDNUM)=$EXTRACT(FIELD,3,$LENGTH(FIELD))
End DoDot:1
IF FIELD=""
QUIT
+15 ;
+16 QUIT
+17 ;
PARSETN ; This subroutine will parse the transaction level segments. For
+1 ; most transactions, the only segment required in this area of
+2 ; the response is the status segment. However, since we aren't
+3 ; sure what we will be getting back, we will process whatever
+4 ; is sent our way.
+5 ;
+6 ; Please note that most fields are optional, so we will parse the
+7 ; record based on field separators and the value of the field
+8 ; identification.
+9 ; Also please note that several of the segments have repeating
+10 ; fields - we will determine which fields are repeating, based
+11 ; on the segment identification.
+12 ;
+13 ; Possible values of the SEGFID field:
+14 ; 21 = Response Status Segment
+15 ; 22 = Response Claim Segment
+16 ; 23 = Response Pricing Segment
+17 ; 24 = Response DUR/PPS Segment
+18 ; 26 = Repsonse Prior Authorization Segment
+19 ; 28 = Response COB (New to D.0)
+20 ; 29 = Response Patient Segment (New to D.0)
+21 ;
+22 NEW FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT
+23 ;
+24 SET RPTFLD=""
+25 ;this should be the segment id
SET SEGID=$PIECE(SEGMENT,FS,2)
+26 ;don't process without a Seg id
IF SEGID=""
QUIT
+27 ;don't know what we have - skip
IF $EXTRACT(SEGID,1,2)'="AM"
QUIT
+28 ;
+29 ;this should be the field ID
SET SEGFID=$EXTRACT(SEGID,3,4)
+30 ;
+31 ; setup the repeating flds based on the segment (526 was changed to a repeating field in D.0)
+32 ;status segment
IF SEGFID=21
Begin DoDot:1
+33 SET RPTFLD=",526,548,511,546,"
+34 SET (RCNT(548),RCNT(511),RCNT(546),RCNT(526))=0
End DoDot:1
+35 ;
+36 ;claim segment
IF SEGFID=22
Begin DoDot:1
+37 SET RPTFLD=",552,553,554,555,556,"
+38 SET (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0
End DoDot:1
+39 ;
+40 ;pricing segment
IF SEGFID=23
Begin DoDot:1
+41 SET RPTFLD=",564,565,"
+42 SET (RCNT(564),RCNT(565))=0
End DoDot:1
+43 ;
+44 ;DUR/PPS segment
IF SEGFID=24
Begin DoDot:1
+45 SET RPTFLD=",439,528,529,530,531,532,533,544,567,"
+46 SET (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0
+47 SET (RCNT(532),RCNT(533),RCNT(544),RCNT(567))=0
End DoDot:1
+48 ;
+49 ; now lets parse out the fields
+50 ;
+51 ;skip the seg id -jump to the other flds
FOR PC=3:1
Begin DoDot:1
+52 ;piece through the record
SET FIELD=$PIECE(SEGMENT,FS,PC)
+53 ;stop - we hit the end
IF FIELD=""
QUIT
+54 ;get the field number used for storage
SET FLDNUM=$$GETNUM(FIELD)
+55 ;IHS/OIT/SCR 11/26/08 - next line avoids subscript error on last line of routine
+56 ;EMERGENCY FIX distributed on 12/2/08 -added to patch 36 011910
+57 IF FLDNUM=""
QUIT
+58 ;for this segment, lets figure
SET REPEAT=0
+59 ;out if the field is a repeating
SET CKRPT=","_FLDNUM_","
+60 ;field
IF RPTFLD[CKRPT
SET REPEAT=1
+61 ;
+62 ;if rptg, store with a counter
IF REPEAT
Begin DoDot:2
+63 SET RCNT(FLDNUM)=$GET(RCNT(FLDNUM))+1
+64 SET FDATA("M",MEDN,FLDNUM,RCNT(FLDNUM))=$EXTRACT(FIELD,3,$LENGTH(FIELD))
End DoDot:2
+65 ;
+66 ;not rptg, store without counter
IF 'REPEAT
Begin DoDot:2
+67 SET FDATA("M",MEDN,FLDNUM)=$EXTRACT(FIELD,3,$LENGTH(FIELD))
End DoDot:2
End DoDot:1
IF FIELD=""
QUIT
+68 ;
+69 ;
+70 QUIT
+71 ;
GETNUM(FIELD) ; This routine will translate the field ID into a field number.
+1 ; We will use the ABSP NCPDP field Defs files, corss ref "D" to
+2 ; perform this translation. (The field number is needed to store
+3 ; the data in the correct field within the response file.)
+4 ;
+5 NEW FLDID,FLDIEN,FLDNUM
+6 SET (FLDID,FLDNUM)=""
+7 SET FLDIEN=0
+8 ;
+9 ;field identifier
SET FLDID=$EXTRACT(FIELD,1,2)
+10 IF FLDID=""
QUIT
+11 ;
+12 IF FLDID'=""
Begin DoDot:1
+13 ;internal fld #
SET FLDIEN=$ORDER(^ABSPF(9002313.91,"D",FLDID,FLDIEN))
+14 ;fld number
IF FLDIEN
SET FLDNUM=$PIECE($GET(^ABSPF(9002313.91,FLDIEN,0)),U)
End DoDot:1
+15 ;
+16 ;
+17 QUIT FLDNUM
+18 ;
