- BPSECMPS ;BHAM ISC/FCS/DRS - Parse Claim Response ;3/10/08 12:31
- ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,6,7,10,11,15,19,20**;JUN 2004;Build 27
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; References to UPDATE^DIE and WP^DIE supported by DBIA 2053
- ; Reference to FDA^DILF supported by DBIA 2054
- ;
- PARSE(RREC,CLAIMIEN,IEN59,TRANTYPE) ;
- ; Parse the response from the payer and file it in the BPS Response record
- ; Incoming Parameters:
- ; RREC - HL7 message
- ; CLAIMIEN - IEN of the BPS Claim file
- ; IEN59 - IEN of the BPS Transaction file
- ; TRANTYPE - Transaction Type (B1-Billing Request, B2-Reversal, E1-Eligibility)
- ; Return value:
- ; RESPIEN - IEN of the BPS Response file
- ;
- N FDAIEN,FDAIEN03,FDATA,FILE,FS,GS,ROOT,SS,TRANSACT,TRANSCNT
- ;
- ; RREC and CLAIMIEN are required
- Q:$G(RREC)="" 0
- Q:$G(CLAIMIEN)="" 0
- ;
- ;group and field separator characters
- S GS="\X1D\",FS="\X1C\",SS="\X1E\"
- S FILE="9002313.03",ROOT="FDATA(9002313.03)"
- D TRANSMSN ; process transmission level data, transaction count in TRANSCNT (from PARSEH)
- D TRANSACT ; process transaction level data
- ;
- ; If test system and test active, call the override routine
- ; IEN59 and TRANTYPE are set in BPSECMC2
- I $$CHECK^BPSTEST D SETOVER^BPSTEST(+$G(IEN59),$G(TRANTYPE),.FDATA)
- ;
- D UPDATE^DIE("S","FDATA(9002313.03)","FDAIEN")
- F TRANSACT=1:1:TRANSCNT D
- .D PROCRESP
- .D PROCREJ
- .D PROCAPP
- .D PROCPPR
- .D PROCCOB
- .D PROCOTH^BPSECMP2
- .D PROCBEN^BPSECMP2
- .D PROCADM^BPSECMP2
- .D PROCDUR^BPSECMP2
- .D PROCINT
- .D PROCQLIM ; process Quantity limit time period multiple
- .D PROCDSLM ; process Days Supply limit time period multiple
- .Q
- ;
- S RESPIEN=FDAIEN(1)
- ; This should be called for each transaction but the IBSEND is not
- ; setup correctly so currently it is only called for each claim/response
- ; If we ever bundle claims, we will need to fix IBSEND and move this code
- ; to the FOR loop above.
- D IBSEND^BPSECMP2(CLAIMIEN,RESPIEN,"","")
- D RAW(RESPIEN,RREC)
- ;
- Q RESPIEN
- ;
- TRANSMSN ;This subroutine will work through the transmission level information
- ;
- N RHEADER,RTRANM,SEG,SEGID,SEGMENT
- ;
- ;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 transmission 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
- .. S SEGFID=$E(SEGID,3,4)
- .. D:(SEGFID=20)!(SEGFID=25) PARSETM
- ;
- Q
- ;
- TRANSACT ;This subroutine will work through the transaction level information
- ;
- N GRP,MEDN,RTRAN,SEG,SEGMENT
- 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 ; parse the header record, required on all responses, and is fixed length
- ; It's the only record that is fixed length.
- ;
- D FDA^DILF(FILE,"+1",.01,"",CLAIMIEN,ROOT) ; CLAIM ID
- D FDA^DILF(FILE,"+1",.02,"",$$NOWFM^BPSOSU1,ROOT) ; DATE RESPONSE RECEIVED
- D FDA^DILF(FILE,"+1",102,"",$E(RHEADER,33,34),ROOT) ; VERSION RELEASE NUMBER
- D FDA^DILF(FILE,"+1",103,"",$E(RHEADER,35,36),ROOT) ; TRANSACTION CODE
- D FDA^DILF(FILE,"+1",109,"",$E(RHEADER,37,37),ROOT) ; TRANSACTION COUNT
- S TRANSCNT=$E(RHEADER,37,37)
- D FDA^DILF(FILE,"+1",501,"",$E(RHEADER,38,38),ROOT) ; response status header
- D FDA^DILF(FILE,"+1",202,"",$E(RHEADER,39,40),ROOT) ; SERVICE PROVIDER ID Qualifier
- D FDA^DILF(FILE,"+1",201,"",$E(RHEADER,41,55),ROOT) ; SERVICE PROVIDER ID
- D FDA^DILF(FILE,"+1",401,"",$E(RHEADER,56,63),ROOT) ; DATE OF SERVICE
- ;
- Q
- ;
- PARSETM ; parse the variable portions of the transmission
- ;
- N FIELD,FLDNUM,PC
- ;
- 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 let's skip
- . S FIELD=$E(FIELD,3,999)
- . D FDA^DILF(FILE,"+1",FLDNUM,"",FIELD,ROOT)
- Q
- ;
- PARSETN ; parse the transaction level segments
- ;
- ; Possible values of the SEGFID field:
- ; 21 = Response Status Segment
- ; 22 = Response Claim Segment
- ; 23 = Response Pricing Segment
- ; 24 = Response DUR/PPS Segment
- ; 26 = Response Prior Authorization Segment
- ; 28 = Response Coordination of Benefits/Other Payers Segment
- ; 36 = Response Intermediary Segment
- ;
- N CKRPT,FIELD,FLDNUM,PC,REPEAT,RPTFLD,SEGFID,SEGID,GRPCNT,GRPFLDS,VNUM
- ;
- 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
- S GRPCNT=0,GRPFLDS=""
- ;
- ; setup the repeating flds based on the segment
- I SEGFID=21 D ;status segment
- . S RPTFLD=",548,511,546,132,526,131,"
- . S GRPCNT=0
- . S GRPFLDS=",511,548,132,"
- ;
- I SEGFID=22 D ;claim segment
- . S RPTFLD=",552,553,554,555,556,B88,B89,B91,B92,"
- . S GRPCNT=0
- . S GRPFLDS=",552,B88,B91,"
- ;
- I SEGFID=23 D ;pricing segment
- . S RPTFLD=",564,565,393,394,"
- . S GRPCNT=0
- . S GRPFLDS=",564,393,"
- ;
- I SEGFID=24 D ;DUR/PPS segment
- . S RPTFLD=",439,528,529,530,531,532,533,544,567,570,"
- . S GRPCNT=0
- . S GRPFLDS=",567,"
- ;
- I SEGFID=28 D ;COB/Other Payers segment
- . S RPTFLD=",127,142,143,144,145,338,339,340,356,991,992,B23,"
- . S GRPCNT=0
- . S GRPFLDS=",338,"
- ;
- I SEGFID=36 D ;Intermediary segment
- . S RPTFLD=",B53,B54,B51,"
- . S GRPCNT=0
- . S GRPFLDS=",B53,"
- ;
- ; now let's 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
- . Q:FLDNUM="" ;shouldn't happen - but let's skip
- . S VNUM=FLDNUM
- . ;Convert to VistA field number for non-numeric NCPDP numbers - BPS*1*15
- . I $P(FLDNUM,".")'?3N S VNUM=$$VNUM(FLDNUM) Q:'VNUM
- . S REPEAT=0 ;for this segment, let's figure
- . S CKRPT=","_FLDNUM_"," ;out if the field is a repeating
- . S:RPTFLD[CKRPT REPEAT=1 ;field
- . ; Increment the group counter if first field of group.
- . S:GRPFLDS[CKRPT GRPCNT=GRPCNT+1
- . ; if rptg, store with a group counter
- . S:REPEAT FDATA(MEDN,VNUM,GRPCNT)=$E(FIELD,3,$L(FIELD))
- . ; not rptg, store without counter
- . S:'REPEAT FDATA(MEDN,VNUM)=$E(FIELD,3,$L(FIELD))
- ;
- Q
- ;
- GETNUM(FIELD) ; function, return field number for a field I
- ; use BPS NCPDP FIELD DEFS (#9002313.91) "D" cross ref for lookup
- ; field number is used to store the data in the correct field in BPS RESPONSES (#9002313.03)
- ;
- N FLDID,FLDIEN,FLDNUM
- S FLDID=$E(FIELD,1,2),FLDNUM=""
- Q:FLDID="" FLDNUM ; FLDID = field identifier
- ;
- S FLDIEN=$O(^BPSF(9002313.91,"D",FLDID,0)) ; ien for fld #
- S:FLDIEN FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,0)),U) ;fld number
- Q FLDNUM
- ;
- VNUM(FLDNUM) ;function, returns VistA FileMan field number
- N FLDIEN
- S FLDIEN=$O(^BPSF(9002313.91,"B",FLDNUM,0)) Q:'FLDIEN ""
- S FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,5)),U,3) ;fld number
- Q FLDNUM
- ;
- PROCRESP ; add data to RESPONSES SUB-FIELD (#9002313.0301)
- ;
- N FDATA03,FIELD,FILE,FLDNUM,ROOT
- ;
- S FILE=9002313.0301,ROOT="FDATA03(9002313.0301)"
- ; field 501 is HEADER RESPONSE STATUS, 112 is TRANSACTION RESPONSE STATUS
- I '$D(FDATA(TRANSACT,501)) S FDATA(TRANSACT,501)=FDATA(TRANSACT,112)
- I '$D(FDATA(TRANSACT,112)) S FDATA(TRANSACT,112)=FDATA(TRANSACT,501)
- ;
- S FLDNUM=".01" D FDA^DILF(FILE,"+1,"_FDAIEN(TRANSACT),FLDNUM,"",TRANSACT,ROOT)
- S FIELD=""
- F S FIELD=$O(FDATA(TRANSACT,FIELD)) Q:FIELD="" D ;set all the non-repeating fields for 9002313.0301
- .Q:$G(FDATA(TRANSACT,FIELD))="" ; no data to process
- .; field 402 is PRESCRIPTION/SERVICE REF. NO.
- .I FIELD=402 S FDATA(TRANSACT,FIELD)=$TR(FDATA(TRANSACT,FIELD),"\","") ;REMOVE EXTRANEOUS "\"
- .D FDA^DILF(FILE,"+"_TRANSACT_","_FDAIEN(TRANSACT),FIELD,"",FDATA(TRANSACT,FIELD),ROOT)
- ;
- D UPDATE^DIE("S","FDATA03(9002313.0301)","FDAIEN03")
- ;
- Q
- ;
- PROCREJ ; add data to REJECT CODE SUB-FIELD (#9002313.03511)
- Q:$G(FDATA(TRANSACT,510))=""
- ;
- N FDAT3511,FILE,FLDNUM,NNDX,NUMREJS,ROOT,REJCODE
- ;
- S FILE="9002313.03511",ROOT="FDAT3511(9002313.03511)",NUMREJS=FDATA(TRANSACT,510),NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,511,NNDX)) Q:NNDX="" D ;set all the non-repeating fields for 9002313.03511 rejections
- .S REJCODE=$$TRIM^XLFSTR(FDATA(TRANSACT,511,NNDX),"R")
- .S REJCODE=$TR(REJCODE,"\","") Q:REJCODE']""
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",REJCODE,ROOT)
- D UPDATE^DIE("S","FDAT3511(9002313.03511)")
- ;
- Q
- ;
- PROCAPP ; APPROVED MESSAGE CODE SUB-FIELD (#9002313.301548)
- Q:$O(FDATA(TRANSACT,548,0))=""
- ;
- N FDAT1548,FILE,FLDNUM,NNDX,ROOT
- ;
- S FILE="9002313.301548",ROOT="FDAT1548(9002313.301548)",NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,548,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,548,NNDX),ROOT)
- D UPDATE^DIE("S","FDAT1548(9002313.301548)")
- ;
- Q
- ;
- PROCPPR ; PREFERRED PRODUCT REPEATING SUB-FIELD (#9002313.1301)
- ;
- Q:$O(FDATA(TRANSACT,552,0))=""
- ;
- N FDAT1301,FILE,FLDNUM,NNDX,ROOT
- ;
- S FILE="9002313.1301",ROOT="FDAT1301(9002313.1301)",NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,552,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=552,553,554,555,556 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDAT1301(9002313.1301)")
- ;
- Q
- PROCCOB ; OTHER PAYER ID MLTPL SUB-FIELD (#9002313.035501)
- ;
- Q:$O(FDATA(TRANSACT,338,0))=""
- ;
- N FDAT35501,FILE,FLDNUM,NNDX,ROOT
- ;
- S FILE="9002313.035501",ROOT="FDAT35501(9002313.035501)",NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,338,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=127,142,143,144,145,338,339,340,356,991,992,2023 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDAT35501(9002313.035501)")
- ;
- Q
- ;
- PROCINT ; INTERMEDIARY REPEATING SUB-FIELD (#9002313.032052)
- ;
- Q:$O(FDATA(TRANSACT,2053,0))=""
- ;
- N FDAT032052,FILE,FLDNUM,NNDX,ROOT
- ;
- S FILE="9002313.032052",ROOT="FDAT032052(9002313.032052)",NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,2053,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=2053,2054,2051 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDAT032052(9002313.032052)")
- Q
- ;
- PROCQLIM ; QUANTITY LIMIT PER SPECIFIC TIME PERIOD REPEATING SUB-FIELD (# 9002313.032087)
- ;
- I '$G(FDATA(TRANSACT,2087)) Q ; if the counter field isn't there, then get out
- ;
- N FDAT032087,FILE,FLDNUM,NNDX,ROOT
- ;
- S FILE="9002313.032087",ROOT="FDAT032087(9002313.032087)",NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,2088,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=2088,2089 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDAT032087(9002313.032087)")
- Q
- ;
- PROCDSLM ; DAYS SUPPLY LIMIT PER SPECIFIC TIME PERIOD REPEATING SUB-FIELD (# 9002313.032091)
- ;
- I '$G(FDATA(TRANSACT,2090)) Q ; if the counter field isn't there, then get out
- ;
- N FDAT032091,FILE,FLDNUM,NNDX,ROOT
- ;
- S FILE="9002313.032091",ROOT="FDAT032091(9002313.032091)",NNDX=""
- F S NNDX=$O(FDATA(TRANSACT,2091,NNDX)) Q:NNDX="" D
- .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- .F FLDNUM=2091,2092 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- D UPDATE^DIE("S","FDAT032091(9002313.032091)")
- Q
- ;
- RAW(RESPIEN,RREC) ; store raw data received from the payer
- ; pass in the response IEN (9002313.03) and the raw data to be stored.
- N X,CNT
- K ^TMP($J,"WP")
- S CNT=0 F X=1:79:$L(RREC) S CNT=CNT+1 S ^TMP($J,"WP",CNT,0)=$E(RREC,X,X+78)
- D WP^DIE(9002313.03,RESPIEN_",",9999,"K","^TMP($J,""WP"")")
- K ^TMP($J,"WP")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSECMPS 13524 printed Jan 18, 2025@02:52:05 Page 2
- BPSECMPS ;BHAM ISC/FCS/DRS - Parse Claim Response ;3/10/08 12:31
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,6,7,10,11,15,19,20**;JUN 2004;Build 27
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; References to UPDATE^DIE and WP^DIE supported by DBIA 2053
- +5 ; Reference to FDA^DILF supported by DBIA 2054
- +6 ;
- PARSE(RREC,CLAIMIEN,IEN59,TRANTYPE) ;
- +1 ; Parse the response from the payer and file it in the BPS Response record
- +2 ; Incoming Parameters:
- +3 ; RREC - HL7 message
- +4 ; CLAIMIEN - IEN of the BPS Claim file
- +5 ; IEN59 - IEN of the BPS Transaction file
- +6 ; TRANTYPE - Transaction Type (B1-Billing Request, B2-Reversal, E1-Eligibility)
- +7 ; Return value:
- +8 ; RESPIEN - IEN of the BPS Response file
- +9 ;
- +10 NEW FDAIEN,FDAIEN03,FDATA,FILE,FS,GS,ROOT,SS,TRANSACT,TRANSCNT
- +11 ;
- +12 ; RREC and CLAIMIEN are required
- +13 if $GET(RREC)=""
- QUIT 0
- +14 if $GET(CLAIMIEN)=""
- QUIT 0
- +15 ;
- +16 ;group and field separator characters
- +17 SET GS="\X1D\"
- SET FS="\X1C\"
- SET SS="\X1E\"
- +18 SET FILE="9002313.03"
- SET ROOT="FDATA(9002313.03)"
- +19 ; process transmission level data, transaction count in TRANSCNT (from PARSEH)
- DO TRANSMSN
- +20 ; process transaction level data
- DO TRANSACT
- +21 ;
- +22 ; If test system and test active, call the override routine
- +23 ; IEN59 and TRANTYPE are set in BPSECMC2
- +24 IF $$CHECK^BPSTEST
- DO SETOVER^BPSTEST(+$GET(IEN59),$GET(TRANTYPE),.FDATA)
- +25 ;
- +26 DO UPDATE^DIE("S","FDATA(9002313.03)","FDAIEN")
- +27 FOR TRANSACT=1:1:TRANSCNT
- Begin DoDot:1
- +28 DO PROCRESP
- +29 DO PROCREJ
- +30 DO PROCAPP
- +31 DO PROCPPR
- +32 DO PROCCOB
- +33 DO PROCOTH^BPSECMP2
- +34 DO PROCBEN^BPSECMP2
- +35 DO PROCADM^BPSECMP2
- +36 DO PROCDUR^BPSECMP2
- +37 DO PROCINT
- +38 ; process Quantity limit time period multiple
- DO PROCQLIM
- +39 ; process Days Supply limit time period multiple
- DO PROCDSLM
- +40 QUIT
- End DoDot:1
- +41 ;
- +42 SET RESPIEN=FDAIEN(1)
- +43 ; This should be called for each transaction but the IBSEND is not
- +44 ; setup correctly so currently it is only called for each claim/response
- +45 ; If we ever bundle claims, we will need to fix IBSEND and move this code
- +46 ; to the FOR loop above.
- +47 DO IBSEND^BPSECMP2(CLAIMIEN,RESPIEN,"","")
- +48 DO RAW(RESPIEN,RREC)
- +49 ;
- +50 QUIT RESPIEN
- +51 ;
- TRANSMSN ;This subroutine will work through the transmission level information
- +1 ;
- +2 NEW RHEADER,RTRANM,SEG,SEGID,SEGMENT
- +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 transmission level - message
- +12 ; and insurance. We'll check for both and parse what we find.
- +13 FOR SEG=2:1:3
- Begin DoDot:1
- +14 SET SEGMENT=$PIECE(RTRANM,SS,SEG)
- +15 if SEGMENT=""
- QUIT
- +16 SET SEGID=$PIECE(SEGMENT,FS,2)
- +17 ; segment identification
- IF $EXTRACT(SEGID,1,2)="AM"
- Begin DoDot:2
- +18 SET SEGFID=$EXTRACT(SEGID,3,4)
- +19 if (SEGFID=20)!(SEGFID=25)
- DO PARSETM
- End DoDot:2
- End DoDot:1
- +20 ;
- +21 QUIT
- +22 ;
- TRANSACT ;This subroutine will work through the transaction level information
- +1 ;
- +2 NEW GRP,MEDN,RTRAN,SEG,SEGMENT
- +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 QUIT
- +15 ;
- PARSEH ; parse the header record, required on all responses, and is fixed length
- +1 ; It's the only record that is fixed length.
- +2 ;
- +3 ; CLAIM ID
- DO FDA^DILF(FILE,"+1",.01,"",CLAIMIEN,ROOT)
- +4 ; DATE RESPONSE RECEIVED
- DO FDA^DILF(FILE,"+1",.02,"",$$NOWFM^BPSOSU1,ROOT)
- +5 ; VERSION RELEASE NUMBER
- DO FDA^DILF(FILE,"+1",102,"",$EXTRACT(RHEADER,33,34),ROOT)
- +6 ; TRANSACTION CODE
- DO FDA^DILF(FILE,"+1",103,"",$EXTRACT(RHEADER,35,36),ROOT)
- +7 ; TRANSACTION COUNT
- DO FDA^DILF(FILE,"+1",109,"",$EXTRACT(RHEADER,37,37),ROOT)
- +8 SET TRANSCNT=$EXTRACT(RHEADER,37,37)
- +9 ; response status header
- DO FDA^DILF(FILE,"+1",501,"",$EXTRACT(RHEADER,38,38),ROOT)
- +10 ; SERVICE PROVIDER ID Qualifier
- DO FDA^DILF(FILE,"+1",202,"",$EXTRACT(RHEADER,39,40),ROOT)
- +11 ; SERVICE PROVIDER ID
- DO FDA^DILF(FILE,"+1",201,"",$EXTRACT(RHEADER,41,55),ROOT)
- +12 ; DATE OF SERVICE
- DO FDA^DILF(FILE,"+1",401,"",$EXTRACT(RHEADER,56,63),ROOT)
- +13 ;
- +14 QUIT
- +15 ;
- PARSETM ; parse the variable portions of the transmission
- +1 ;
- +2 NEW FIELD,FLDNUM,PC
- +3 ;
- +4 ;skip the seg id -already know its value
- FOR PC=3:1
- Begin DoDot:1
- +5 ;piece through the record
- SET FIELD=$PIECE(SEGMENT,FS,PC)
- +6 ;stop - we hit the end
- if FIELD=""
- QUIT
- +7 ;get the field number used for storage
- SET FLDNUM=$$GETNUM(FIELD)
- +8 ;shouldn't happen - but let's skip
- if FLDNUM=""
- QUIT
- +9 SET FIELD=$EXTRACT(FIELD,3,999)
- +10 DO FDA^DILF(FILE,"+1",FLDNUM,"",FIELD,ROOT)
- End DoDot:1
- if FIELD=""
- QUIT
- +11 QUIT
- +12 ;
- PARSETN ; parse the transaction level segments
- +1 ;
- +2 ; Possible values of the SEGFID field:
- +3 ; 21 = Response Status Segment
- +4 ; 22 = Response Claim Segment
- +5 ; 23 = Response Pricing Segment
- +6 ; 24 = Response DUR/PPS Segment
- +7 ; 26 = Response Prior Authorization Segment
- +8 ; 28 = Response Coordination of Benefits/Other Payers Segment
- +9 ; 36 = Response Intermediary Segment
- +10 ;
- +11 NEW CKRPT,FIELD,FLDNUM,PC,REPEAT,RPTFLD,SEGFID,SEGID,GRPCNT,GRPFLDS,VNUM
- +12 ;
- +13 SET RPTFLD=""
- +14 ; this should be the segment id
- SET SEGID=$PIECE(SEGMENT,FS,2)
- +15 ; don't process without a Seg id
- if SEGID=""
- QUIT
- +16 ; don't know what we have - skip
- if $EXTRACT(SEGID,1,2)'="AM"
- QUIT
- +17 ;
- +18 ; this should be the field ID
- SET SEGFID=$EXTRACT(SEGID,3,4)
- +19 SET GRPCNT=0
- SET GRPFLDS=""
- +20 ;
- +21 ; setup the repeating flds based on the segment
- +22 ;status segment
- IF SEGFID=21
- Begin DoDot:1
- +23 SET RPTFLD=",548,511,546,132,526,131,"
- +24 SET GRPCNT=0
- +25 SET GRPFLDS=",511,548,132,"
- End DoDot:1
- +26 ;
- +27 ;claim segment
- IF SEGFID=22
- Begin DoDot:1
- +28 SET RPTFLD=",552,553,554,555,556,B88,B89,B91,B92,"
- +29 SET GRPCNT=0
- +30 SET GRPFLDS=",552,B88,B91,"
- End DoDot:1
- +31 ;
- +32 ;pricing segment
- IF SEGFID=23
- Begin DoDot:1
- +33 SET RPTFLD=",564,565,393,394,"
- +34 SET GRPCNT=0
- +35 SET GRPFLDS=",564,393,"
- End DoDot:1
- +36 ;
- +37 ;DUR/PPS segment
- IF SEGFID=24
- Begin DoDot:1
- +38 SET RPTFLD=",439,528,529,530,531,532,533,544,567,570,"
- +39 SET GRPCNT=0
- +40 SET GRPFLDS=",567,"
- End DoDot:1
- +41 ;
- +42 ;COB/Other Payers segment
- IF SEGFID=28
- Begin DoDot:1
- +43 SET RPTFLD=",127,142,143,144,145,338,339,340,356,991,992,B23,"
- +44 SET GRPCNT=0
- +45 SET GRPFLDS=",338,"
- End DoDot:1
- +46 ;
- +47 ;Intermediary segment
- IF SEGFID=36
- Begin DoDot:1
- +48 SET RPTFLD=",B53,B54,B51,"
- +49 SET GRPCNT=0
- +50 SET GRPFLDS=",B53,"
- End DoDot:1
- +51 ;
- +52 ; now let's parse out the fields
- +53 ;
- +54 ;skip the seg id -jump to the other flds
- FOR PC=3:1
- Begin DoDot:1
- +55 ;piece through the record
- SET FIELD=$PIECE(SEGMENT,FS,PC)
- +56 ;stop - we hit the end
- if FIELD=""
- QUIT
- +57 ;get the field number used for storage
- SET FLDNUM=$$GETNUM(FIELD)
- +58 ;shouldn't happen - but let's skip
- if FLDNUM=""
- QUIT
- +59 SET VNUM=FLDNUM
- +60 ;Convert to VistA field number for non-numeric NCPDP numbers - BPS*1*15
- +61 IF $PIECE(FLDNUM,".")'?3N
- SET VNUM=$$VNUM(FLDNUM)
- if 'VNUM
- QUIT
- +62 ;for this segment, let's figure
- SET REPEAT=0
- +63 ;out if the field is a repeating
- SET CKRPT=","_FLDNUM_","
- +64 ;field
- if RPTFLD[CKRPT
- SET REPEAT=1
- +65 ; Increment the group counter if first field of group.
- +66 if GRPFLDS[CKRPT
- SET GRPCNT=GRPCNT+1
- +67 ; if rptg, store with a group counter
- +68 if REPEAT
- SET FDATA(MEDN,VNUM,GRPCNT)=$EXTRACT(FIELD,3,$LENGTH(FIELD))
- +69 ; not rptg, store without counter
- +70 if 'REPEAT
- SET FDATA(MEDN,VNUM)=$EXTRACT(FIELD,3,$LENGTH(FIELD))
- End DoDot:1
- if FIELD=""
- QUIT
- +71 ;
- +72 QUIT
- +73 ;
- GETNUM(FIELD) ; function, return field number for a field I
- +1 ; use BPS NCPDP FIELD DEFS (#9002313.91) "D" cross ref for lookup
- +2 ; field number is used to store the data in the correct field in BPS RESPONSES (#9002313.03)
- +3 ;
- +4 NEW FLDID,FLDIEN,FLDNUM
- +5 SET FLDID=$EXTRACT(FIELD,1,2)
- SET FLDNUM=""
- +6 ; FLDID = field identifier
- if FLDID=""
- QUIT FLDNUM
- +7 ;
- +8 ; ien for fld #
- SET FLDIEN=$ORDER(^BPSF(9002313.91,"D",FLDID,0))
- +9 ;fld number
- if FLDIEN
- SET FLDNUM=$PIECE($GET(^BPSF(9002313.91,FLDIEN,0)),U)
- +10 QUIT FLDNUM
- +11 ;
- VNUM(FLDNUM) ;function, returns VistA FileMan field number
- +1 NEW FLDIEN
- +2 SET FLDIEN=$ORDER(^BPSF(9002313.91,"B",FLDNUM,0))
- if 'FLDIEN
- QUIT ""
- +3 ;fld number
- SET FLDNUM=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U,3)
- +4 QUIT FLDNUM
- +5 ;
- PROCRESP ; add data to RESPONSES SUB-FIELD (#9002313.0301)
- +1 ;
- +2 NEW FDATA03,FIELD,FILE,FLDNUM,ROOT
- +3 ;
- +4 SET FILE=9002313.0301
- SET ROOT="FDATA03(9002313.0301)"
- +5 ; field 501 is HEADER RESPONSE STATUS, 112 is TRANSACTION RESPONSE STATUS
- +6 IF '$DATA(FDATA(TRANSACT,501))
- SET FDATA(TRANSACT,501)=FDATA(TRANSACT,112)
- +7 IF '$DATA(FDATA(TRANSACT,112))
- SET FDATA(TRANSACT,112)=FDATA(TRANSACT,501)
- +8 ;
- +9 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+1,"_FDAIEN(TRANSACT),FLDNUM,"",TRANSACT,ROOT)
- +10 SET FIELD=""
- +11 ;set all the non-repeating fields for 9002313.0301
- FOR
- SET FIELD=$ORDER(FDATA(TRANSACT,FIELD))
- if FIELD=""
- QUIT
- Begin DoDot:1
- +12 ; no data to process
- if $GET(FDATA(TRANSACT,FIELD))=""
- QUIT
- +13 ; field 402 is PRESCRIPTION/SERVICE REF. NO.
- +14 ;REMOVE EXTRANEOUS "\"
- IF FIELD=402
- SET FDATA(TRANSACT,FIELD)=$TRANSLATE(FDATA(TRANSACT,FIELD),"\","")
- +15 DO FDA^DILF(FILE,"+"_TRANSACT_","_FDAIEN(TRANSACT),FIELD,"",FDATA(TRANSACT,FIELD),ROOT)
- End DoDot:1
- +16 ;
- +17 DO UPDATE^DIE("S","FDATA03(9002313.0301)","FDAIEN03")
- +18 ;
- +19 QUIT
- +20 ;
- PROCREJ ; add data to REJECT CODE SUB-FIELD (#9002313.03511)
- +1 if $GET(FDATA(TRANSACT,510))=""
- QUIT
- +2 ;
- +3 NEW FDAT3511,FILE,FLDNUM,NNDX,NUMREJS,ROOT,REJCODE
- +4 ;
- +5 SET FILE="9002313.03511"
- SET ROOT="FDAT3511(9002313.03511)"
- SET NUMREJS=FDATA(TRANSACT,510)
- SET NNDX=""
- +6 ;set all the non-repeating fields for 9002313.03511 rejections
- FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,511,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +7 SET REJCODE=$$TRIM^XLFSTR(FDATA(TRANSACT,511,NNDX),"R")
- +8 SET REJCODE=$TRANSLATE(REJCODE,"\","")
- if REJCODE']""
- QUIT
- +9 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",REJCODE,ROOT)
- End DoDot:1
- +10 DO UPDATE^DIE("S","FDAT3511(9002313.03511)")
- +11 ;
- +12 QUIT
- +13 ;
- PROCAPP ; APPROVED MESSAGE CODE SUB-FIELD (#9002313.301548)
- +1 if $ORDER(FDATA(TRANSACT,548,0))=""
- QUIT
- +2 ;
- +3 NEW FDAT1548,FILE,FLDNUM,NNDX,ROOT
- +4 ;
- +5 SET FILE="9002313.301548"
- SET ROOT="FDAT1548(9002313.301548)"
- SET NNDX=""
- +6 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,548,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +7 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,548,NNDX),ROOT)
- End DoDot:1
- +8 DO UPDATE^DIE("S","FDAT1548(9002313.301548)")
- +9 ;
- +10 QUIT
- +11 ;
- PROCPPR ; PREFERRED PRODUCT REPEATING SUB-FIELD (#9002313.1301)
- +1 ;
- +2 if $ORDER(FDATA(TRANSACT,552,0))=""
- QUIT
- +3 ;
- +4 NEW FDAT1301,FILE,FLDNUM,NNDX,ROOT
- +5 ;
- +6 SET FILE="9002313.1301"
- SET ROOT="FDAT1301(9002313.1301)"
- SET NNDX=""
- +7 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,552,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +8 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +9 FOR FLDNUM=552,553,554,555,556
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +10 DO UPDATE^DIE("S","FDAT1301(9002313.1301)")
- +11 ;
- +12 QUIT
- PROCCOB ; OTHER PAYER ID MLTPL SUB-FIELD (#9002313.035501)
- +1 ;
- +2 if $ORDER(FDATA(TRANSACT,338,0))=""
- QUIT
- +3 ;
- +4 NEW FDAT35501,FILE,FLDNUM,NNDX,ROOT
- +5 ;
- +6 SET FILE="9002313.035501"
- SET ROOT="FDAT35501(9002313.035501)"
- SET NNDX=""
- +7 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,338,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +8 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +9 FOR FLDNUM=127,142,143,144,145,338,339,340,356,991,992,2023
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +10 DO UPDATE^DIE("S","FDAT35501(9002313.035501)")
- +11 ;
- +12 QUIT
- +13 ;
- PROCINT ; INTERMEDIARY REPEATING SUB-FIELD (#9002313.032052)
- +1 ;
- +2 if $ORDER(FDATA(TRANSACT,2053,0))=""
- QUIT
- +3 ;
- +4 NEW FDAT032052,FILE,FLDNUM,NNDX,ROOT
- +5 ;
- +6 SET FILE="9002313.032052"
- SET ROOT="FDAT032052(9002313.032052)"
- SET NNDX=""
- +7 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,2053,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +8 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +9 FOR FLDNUM=2053,2054,2051
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +10 DO UPDATE^DIE("S","FDAT032052(9002313.032052)")
- +11 QUIT
- +12 ;
- PROCQLIM ; QUANTITY LIMIT PER SPECIFIC TIME PERIOD REPEATING SUB-FIELD (# 9002313.032087)
- +1 ;
- +2 ; if the counter field isn't there, then get out
- IF '$GET(FDATA(TRANSACT,2087))
- QUIT
- +3 ;
- +4 NEW FDAT032087,FILE,FLDNUM,NNDX,ROOT
- +5 ;
- +6 SET FILE="9002313.032087"
- SET ROOT="FDAT032087(9002313.032087)"
- SET NNDX=""
- +7 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,2088,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +8 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +9 FOR FLDNUM=2088,2089
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +10 DO UPDATE^DIE("S","FDAT032087(9002313.032087)")
- +11 QUIT
- +12 ;
- PROCDSLM ; DAYS SUPPLY LIMIT PER SPECIFIC TIME PERIOD REPEATING SUB-FIELD (# 9002313.032091)
- +1 ;
- +2 ; if the counter field isn't there, then get out
- IF '$GET(FDATA(TRANSACT,2090))
- QUIT
- +3 ;
- +4 NEW FDAT032091,FILE,FLDNUM,NNDX,ROOT
- +5 ;
- +6 SET FILE="9002313.032091"
- SET ROOT="FDAT032091(9002313.032091)"
- SET NNDX=""
- +7 FOR
- SET NNDX=$ORDER(FDATA(TRANSACT,2091,NNDX))
- if NNDX=""
- QUIT
- Begin DoDot:1
- +8 SET FLDNUM=".01"
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT)
- +9 FOR FLDNUM=2091,2092
- IF $DATA(FDATA(TRANSACT,FLDNUM,NNDX))
- DO FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$GET(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT)
- End DoDot:1
- +10 DO UPDATE^DIE("S","FDAT032091(9002313.032091)")
- +11 QUIT
- +12 ;
- RAW(RESPIEN,RREC) ; store raw data received from the payer
- +1 ; pass in the response IEN (9002313.03) and the raw data to be stored.
- +2 NEW X,CNT
- +3 KILL ^TMP($JOB,"WP")
- +4 SET CNT=0
- FOR X=1:79:$LENGTH(RREC)
- SET CNT=CNT+1
- SET ^TMP($JOB,"WP",CNT,0)=$EXTRACT(RREC,X,X+78)
- +5 DO WP^DIE(9002313.03,RESPIEN_",",9999,"K","^TMP($J,""WP"")")
- +6 KILL ^TMP($JOB,"WP")
- +7 QUIT
- +8 ;