ABSPOSH4 ; IHS/FCS/DRS - Parse Claim 5.1,D.0 Response ; [ 09/04/2002 12:56 PM ]
;;1.0;PHARMACY POINT OF SALE;**3,14,36,42,46**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Parse ASCII Response Claim Record and Sup FDATA() Array
;
;Parameters: RREC - Ascii Response Record
; RESPIEN - Claim Response IEN (90023130.3)
;----------------------------------------------------------------------
; Calls ABSPOSH5
;
;----------------------------------------------------------------------
; IHS/SD/lwj 8/6/02 NCPDP 5.1 changes
; NCPDP 5.1 response segments are completely different than the
; 3.2 response. Of significant importance are:
; In 3.2, there were 4 basic repsonse segments (header required,
; header option, information required, information optional.)
; In 5.1, there are 8 possible segments (header, message, insurance,
; status, claim, pricing, DUR/PPS, and prior authorization)
;
; In 5.1, for all segments following the header, a segment separator
; is used.
;
; In 5.1, field separators, and field identifiers are used for all
; fields not appearing on the header segment.
;
; This routine will be solely responsible for parsing the data
; for 5.1 claims. It is called by ABSPECA4.
;----------------------------------------------------------------------
;IHS/SD/lwj 10/27/05 patch 14 - new subroutine added to parse out the
; E1 response
;
;----------------------------------------------------------------------
;IHS/SD/lwj 10/27/05 patch 14 - new subroutine for E1 parsing
PARSEE1(RREC,E1IEN) ;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
;
PARSE51(RREC,RESPIEN) ;EP - from ABSPECA4
N GS,FS,SS
;
;Make sure input varaibles 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
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.
;
; OIT/CAS/RCS 092013 Patch 46 More that two segments are allowed
F SEG=2:1 S SEGMENT=$P(RTRANM,SS,SEG) Q:SEGMENT="" D
. 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
. I ($E(SEGID,3,4)=27)!($E(SEGID,3,4)=29) S MEDN=1 D PARSETN ;D.0 Record
;
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 = Other Payer Segment
;
N FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT,OCNT
;
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
I SEGFID=21 D ;status segment
. S RPTFLD=",548,511,546,526,"
. 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
;
I SEGFID=28 D Q ;Other Payer segment
. 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
. . Q:FLDNUM=""
. . I FLDNUM=355 Q
. . I FLDNUM=338 S OCNT=+$E(FIELD,3,$L(FIELD)) ;Other coverage type
. . S FDATA("M",MEDN,FLDNUM,OCNT)=$E(FIELD,3,$L(FIELD))
;
; 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=""
. I ",304,310,311,"[(","_FLDNUM_",") S FLDNUM=FLDNUM_".01" ;Save response data to different field
. 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
;
ABSPOSH4 ; IHS/FCS/DRS - Parse Claim 5.1,D.0 Response ; [ 09/04/2002 12:56 PM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,14,36,42,46**;JUN 21, 2001;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 ; Calls ABSPOSH5
+10 ;
+11 ;----------------------------------------------------------------------
+12 ; IHS/SD/lwj 8/6/02 NCPDP 5.1 changes
+13 ; NCPDP 5.1 response segments are completely different than the
+14 ; 3.2 response. Of significant importance are:
+15 ; In 3.2, there were 4 basic repsonse segments (header required,
+16 ; header option, information required, information optional.)
+17 ; In 5.1, there are 8 possible segments (header, message, insurance,
+18 ; status, claim, pricing, DUR/PPS, and prior authorization)
+19 ;
+20 ; In 5.1, for all segments following the header, a segment separator
+21 ; is used.
+22 ;
+23 ; In 5.1, field separators, and field identifiers are used for all
+24 ; fields not appearing on the header segment.
+25 ;
+26 ; This routine will be solely responsible for parsing the data
+27 ; for 5.1 claims. It is called by ABSPECA4.
+28 ;----------------------------------------------------------------------
+29 ;IHS/SD/lwj 10/27/05 patch 14 - new subroutine added to parse out the
+30 ; E1 response
+31 ;
+32 ;----------------------------------------------------------------------
+33 ;IHS/SD/lwj 10/27/05 patch 14 - new subroutine for E1 parsing
PARSEE1(RREC,E1IEN) ;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 ;
PARSE51(RREC,RESPIEN) ;EP - from ABSPECA4
+1 NEW GS,FS,SS
+2 ;
+3 ;Make sure input varaibles 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 ;add information to the response file
DO FILE^ABSPOSH5(RESPIEN)
+14 ;
+15 QUIT
+16 ;
+17 ;
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 ; OIT/CAS/RCS 092013 Patch 46 More that two segments are allowed
+15 FOR SEG=2:1
SET SEGMENT=$PIECE(RTRANM,SS,SEG)
IF SEGMENT=""
QUIT
Begin DoDot:1
+16 SET SEGID=$PIECE(SEGMENT,FS,2)
+17 ;segment identification
IF $EXTRACT(SEGID,1,2)="AM"
Begin DoDot:2
End DoDot:2
+18 IF ($EXTRACT(SEGID,3,4)=20)!($EXTRACT(SEGID,3,4)=25)
DO PARSETM
+19 ;D.0 Record
IF ($EXTRACT(SEGID,3,4)=27)!($EXTRACT(SEGID,3,4)=29)
SET MEDN=1
DO PARSETN
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 = Other Payer Segment
+20 ;
+21 NEW FIELD,PC,FLDNUM,RPTFLD,RCNT,REPEAT,OCNT
+22 ;
+23 SET RPTFLD=""
+24 ;this should be the segment id
SET SEGID=$PIECE(SEGMENT,FS,2)
+25 ;don't process without a Seg id
IF SEGID=""
QUIT
+26 ;don't know what we have - skip
IF $EXTRACT(SEGID,1,2)'="AM"
QUIT
+27 ;
+28 ;this should be the field ID
SET SEGFID=$EXTRACT(SEGID,3,4)
+29 ;
+30 ; setup the repeating flds based on the segment
+31 ;status segment
IF SEGFID=21
Begin DoDot:1
+32 SET RPTFLD=",548,511,546,526,"
+33 SET (RCNT(548),RCNT(511),RCNT(546),RCNT(526))=0
End DoDot:1
+34 ;
+35 ;claim segment
IF SEGFID=22
Begin DoDot:1
+36 SET RPTFLD=",552,553,554,555,556,"
+37 SET (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0
End DoDot:1
+38 ;
+39 ;pricing segment
IF SEGFID=23
Begin DoDot:1
+40 SET RPTFLD=",564,565,"
+41 SET (RCNT(564),RCNT(565))=0
End DoDot:1
+42 ;
+43 ;DUR/PPS segment
IF SEGFID=24
Begin DoDot:1
+44 SET RPTFLD=",439,528,529,530,531,532,533,544,567,"
+45 SET (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0
+46 SET (RCNT(532),RCNT(533),RCNT(544),RCNT(567))=0
End DoDot:1
+47 ;
+48 ;Other Payer segment
IF SEGFID=28
Begin DoDot:1
+49 ;skip the seg id -jump to the other flds
FOR PC=3:1
Begin DoDot:2
+50 ;piece through the record
SET FIELD=$PIECE(SEGMENT,FS,PC)
+51 ;stop - we hit the end
IF FIELD=""
QUIT
+52 ;get the field number used for storage
SET FLDNUM=$$GETNUM(FIELD)
+53 IF FLDNUM=""
QUIT
+54 IF FLDNUM=355
QUIT
+55 ;Other coverage type
IF FLDNUM=338
SET OCNT=+$EXTRACT(FIELD,3,$LENGTH(FIELD))
+56 SET FDATA("M",MEDN,FLDNUM,OCNT)=$EXTRACT(FIELD,3,$LENGTH(FIELD))
End DoDot:2
IF FIELD=""
QUIT
End DoDot:1
QUIT
+57 ;
+58 ; now lets parse out the fields
+59 ;
+60 ;skip the seg id -jump to the other flds
FOR PC=3:1
Begin DoDot:1
+61 ;piece through the record
SET FIELD=$PIECE(SEGMENT,FS,PC)
+62 ;stop - we hit the end
IF FIELD=""
QUIT
+63 ;get the field number used for storage
SET FLDNUM=$$GETNUM(FIELD)
+64 ;IHS/OIT/SCR 11/26/08 - next line avoids subscript error on last line of routine
+65 ;EMERGENCY FIX distributed on 12/2/08 -added to patch 36 011910
+66 IF FLDNUM=""
QUIT
+67 ;Save response data to different field
IF ",304,310,311,"[(","_FLDNUM_",")
SET FLDNUM=FLDNUM_".01"
+68 ;for this segment, lets figure
SET REPEAT=0
+69 ;out if the field is a repeating
SET CKRPT=","_FLDNUM_","
+70 ;field
IF RPTFLD[CKRPT
SET REPEAT=1
+71 ;
+72 ;if rptg, store with a counter
IF REPEAT
Begin DoDot:2
+73 SET RCNT(FLDNUM)=$GET(RCNT(FLDNUM))+1
+74 SET FDATA("M",MEDN,FLDNUM,RCNT(FLDNUM))=$EXTRACT(FIELD,3,$LENGTH(FIELD))
End DoDot:2
+75 ;
+76 ;not rptg, store without counter
IF 'REPEAT
Begin DoDot:2
+77 SET FDATA("M",MEDN,FLDNUM)=$EXTRACT(FIELD,3,$LENGTH(FIELD))
End DoDot:2
End DoDot:1
IF FIELD=""
QUIT
+78 ;
+79 ;
+80 QUIT
+81 ;
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 ;
