Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSECMPS

BPSECMPS.m

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