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

IBCE277.m

Go to the documentation of this file. 
  1. IBCE277 ;ALB/TMP - 277 EDI CLAIM STATUS MESSAGE PROCESSING ;15-JUL-98
  1.  ;;2.0;INTEGRATED BILLING;**137,155,368,403,650,665**;21-MAR-94;Build 28
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ; MESSAGE HEADER DATA STRING =
  1.  ;   type of message^msg queue^msg #^bill #^REF NUM/Batch #^date/time
  1.  ;
  1. HDR(ENTITY,ENTVAL,IBTYPE,IBD) ;Process header data
  1.  ; INPUT:
  1.  ;   ENTITY = "BATCH" or "CLAIM" for batch/claim level messages respectively
  1.  ;   ENTVAL = claim #
  1.  ;   IBTYPE = the type of status msg this piece of the message represents
  1.  ;             (837REC1, 837REJ1)
  1.  ;   ^TMP("IBMSGH",$J,0) = header message text
  1.  ;
  1.  ; OUTPUT:
  1.  ;   IBD array returned with processed data
  1.  ;      "DATE" = Date/Time of status (Fileman format)
  1.  ;      "MRA" =  1 if MRA, 0 if not         "X12" = 1 if X12, 0 if not
  1.  ;      "BATCH" = Batch ien for batch level calls
  1.  ;      "SOURCE" = Source of message code^source name, if known
  1.  ;
  1.  ;   ^TMP("IBMSG",$J,"BATCH",batch #,0)=MESSAGE HEADER DATA STRING
  1.  ;                                      if batch level message
  1.  ;                                  ,"D",0,1)=header record raw data
  1.  ;                                  ,line #)=batch status message lines
  1.  ;
  1.  ;   ^TMP("IBMSG",$J,"CLAIM",claim #,0)=MESSAGE HEADER DATA STRING
  1.  ;                                      if claim level message
  1.  ;                                  ,"D",0,1)=header record raw data
  1.  ;                                  ,line #)=claim status message lines
  1.  ;
  1.  N DATA,IBD0,L,PC,X,Y
  1.  S IBD0=$G(^TMP("IBMSGH",$J,0)) Q:IBD0=""
  1.  S Y=0,L=1
  1.  ; Convert claim date/time
  1.  S X=$$DATE($P(IBD0,U,3))_"@"_$E($P(IBD0,U,4)_"0000",1,4) I X S %DT="XTS" D ^%DT
  1.  ; populate IBD array
  1.  S IBD("DATE")=$S(Y>0:Y,1:""),IBD("MRA")=$P(IBD0,U,5),IBD("X12")=($P(IBD0,U,2)="X")
  1.  S IBD("SOURCE")=$P(IBD0,U,12,13),IBD("BATCH")=$P(IBD0,U,14)
  1.  I +$TR($P(IBD0,U,6,9),U) F PC=6:1:9 D
  1.  .I $P(IBD0,U,PC)'="" S DATA=$P("# Claims Submitted^# Claims Rejected^Total Charges Submitted^Total Charges Rejected",U,PC-5)_": "_$S(PC<8:+$P(IBD0,U,PC),1:$FNUMBER($P(IBD0,U,PC)/100,"",2))_"  "
  1.  .I $L($G(^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)))+$L(DATA)>70 S L=L+1 ; if data doesn't fit into current line, go to the next line
  1.  .S ^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)=$G(^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L))_DATA ; file this piece of data
  1.  .Q
  1.  ; file batch ref. number
  1.  S:IBD("BATCH")'="" L=L+1,^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)="Batch Reference Number: "_IBD("BATCH")
  1.  I $TR($P(IBD0,U,10,13),U)'="" D
  1.  .S L=L+1
  1.  .; generate and file Payer Name / Payer Id line
  1.  .S DATA="Payer Name: "_$S($P(IBD0,U,10)'="":$P(IBD0,U,10),1:"N/A")_"  Payer ID: "_$S($P(IBD0,U,11)'="":$P(IBD0,U,11),1:"N/A")
  1.  .S ^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)=DATA
  1.  .I $P(IBD0,U,12)'=""!($P(IBD0,U,13)'="") D
  1.  ..; generate and file Message Source line
  1.  ..S DATA="Source: "_$S($P(IBD0,U,12)="Y":"Sent by payer",$P(IBD0,U,13)'="":"Sent by non-payer ("_$P(IBD0,U,13)_")",1:"UNKNOWN")
  1.  ..S L=L+1,^TMP("IBMSG-H",$J,ENTITY,ENTVAL,L)=DATA
  1.  ..Q
  1.  .Q
  1.  S ^TMP("IBMSG",$J,ENTITY,ENTVAL,0)=IBTYPE_U_$G(IBD("MSG#"))_U_$G(IBD("SUBJ"))_U_$$GETBILL(ENTVAL)_U_U_IBD("DATE")_U_IBD("SOURCE")
  1.  ; file raw data
  1.  S ^TMP("IBMSG",$J,ENTITY,ENTVAL,"D",0,1)="##RAW DATA: "_IBD0
  1.  Q
  1.  ;
  1. 9(IBD) ; Process Message Header record
  1.  ; INPUT:
  1.  ;   IBD must be passed by reference = entire message line
  1.  ; OUTPUT:
  1.  ;   IBD array returned with processed data
  1.  ;      "CLAIM" = claim #
  1.  ;      "LINE" = last line # populated in the message
  1.  ;
  1.  ;   ^TMP("IBMSG",$J,"CLAIM",claim #,line#)= message data lines
  1.  ;                                  ,"D",9,msg seq #)= raw data
  1.  N ENTITY,ERR,FLD,IBCLM,IBIFN,L
  1.  ;D STRTREC Q:IBCLM=""  ; if no claim/batch number, bail out  ;JRA IB*2.0*650 ';'
  1.  D STRTREC Q:(IBCLM=""!('IBIFN))  ; if no claim/claim IEN, bail out  ;JRA IB*2.0*650
  1.  ; make sure that we have data to file
  1.  S ERR=$P(IBD,U,4) Q:ERR=""
  1.  ; file error along with corresponding field number (if available)
  1.  S L=L+1,FLD=$P(IBD,U,5),^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Error"_$S(FLD'="":" in field "_FLD,1:"")_":"
  1.  S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=ERR
  1.  D ENDREC(9)
  1.  Q
  1.  ;
  1. 10(IBD) ; Process message data
  1.  ; INPUT:
  1.  ;   IBD must be passed by reference = entire message line
  1.  ; OUTPUT:
  1.  ;   IBD array returned with processed data
  1.  ;      "CLAIM" = claim #
  1.  ;      "LINE" = last line # populated in the message
  1.  ;
  1.  ;   ^TMP("IBMSG",$J,"CLAIM",claim #,line#)= message data lines
  1.  ;                                  ,"D",10,msg seq #)= raw data
  1.  ;   ^TMP("IBCONF",$J,claim #")="" for invalid claims within the batch
  1.  ;
  1.  N CODE,DATA,ENTITY,IBCLM,IBIFN,IBTYPE,L,Z
  1.  ;D STRTREC Q:IBCLM=""  ; if no claim number, bail out  ;JRA IB*2.0*650 ';'
  1.  D STRTREC Q:(IBCLM=""!('IBIFN))  ; if no claim number/claim IEN, bail out  ;JRA IB*2.0*650
  1.  S:$P(IBD,U,3)="R" ^TMP("IBCONF",$J,IBIFN)=""
  1.  S IBTYPE=$S($P(IBD,U,3)="R":"837REJ1",1:"837REC1")
  1.  ;Process header data if not already done
  1.  I '$D(^TMP("IBMSG",$J,ENTITY,IBCLM,0)) D HDR(ENTITY,IBCLM,IBTYPE,.IBD)
  1.  I IBTYPE="837REJ1",$P($G(^TMP("IBMSG",$J,ENTITY,IBCLM,0)),U,1)'="837REJ1" D HDR(ENTITY,IBCLM,IBTYPE,.IBD)
  1.  S CODE=$P(IBD,U,4) I CODE'="",$TR($P(IBD,U,5,6),U)'="" D
  1.  .;JRA IB*2.0*650 Make status code flag claim specific to handle multiple claims of the same status. 
  1.  .;S Z=CODE_$P(IBD,U,5) I Z'=$G(IBD("SCODE")) D  ;JRA IB*2.0*650 ';'
  1.  .S Z=CODE_$P(IBD,U,5) I Z'=$G(IBD("SCODE",IBCLM)) D  ;JRA IB*2.0*650
  1.  ..; determine type of status code and file it
  1.  ..S L=L+1,DATA=$S(CODE="W":"Warning",CODE="E":"Error",1:"Informational")_" "
  1.  ..I $P(IBD,U,5)'="" S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)=DATA_"Code: "_$P(IBD,U,5)
  1.  ..I $P(IBD,U,6)'="" S:$P(IBD,U,5)'="" L=L+1 S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)=DATA_"Message:",L=L+1
  1.  ..;S IBD("SCODE")=Z  ;JRA IB*2.0*650 ';'
  1.  ..S IBD("SCODE",IBCLM)=Z  ;JRA IB*2.0*650
  1.  ..Q
  1.  .; file status message
  1.  .I $P(IBD,U,6)'="" S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)=$P(IBD,U,6),L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)=" "
  1.  .Q
  1.  D ENDREC(10)
  1.  Q
  1.  ;
  1. 13(IBD) ; Process claim data
  1.  ; Claim must have been referenced by a previous '10' level
  1.  ; INPUT:
  1.  ;   IBD must be passed by reference = entire message line
  1.  ;
  1.  ; OUTPUT:
  1.  ;      IBD("LINE") = The last line # populated in the message
  1.  ;
  1.  ;     ^TMP("IBMSG",$J,"CLAIM",claim #,line#)=claim data lines
  1.  ;                                    ,"D",13,msg seq #)=raw data
  1.  ;
  1.  N CTYPE,ENTITY,IBCLM,IBIFN,L,Z1,Z2
  1.  ;D STRTREC  ;JRA IB*2.0*650 ';'
  1.  D STRTREC Q:'IBIFN  ;JRA IB*2.0*650 QUIT if no claim IEN
  1.  ; quit if no claim number or no previous 'line 10' record
  1.  Q:$S(IBCLM="":1,1:'$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)))
  1.  ; file clearinghouse trace number
  1.  I $P(IBD,U,3)'="" S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Clearinghouse Trace Number: "_$P(IBD,U,3)
  1.  ; file payer status date
  1.  I $P(IBD,U,4)'="" S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="         Payer Status Date: "_$$DATE($P(IBD,U,4))
  1.  ; file payer claim number
  1.  I $P(IBD,U,5)'="" S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="        Payer Claim Number: "_$P(IBD,U,5)
  1.  ; file split claim indicator
  1.  I +$P(IBD,U,6)'=0 S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="               Split Claim: "_$S(+$P(IBD,U,6)=1:"No",1:"Yes ("_+$P(IBD,U,6)_" parts)")
  1.  ; file claim type if it either doesn't match value in VistA or if it's a dental claim
  1.  S Z1=$P(IBD,U,7),Z2=$$FT^IBCEF(IBIFN),CTYPE=$S(Z1="P"&(Z2'=2):"Professional",Z1="I"&(Z2'=3):"Institutional",Z1="D":"Dental",1:"")
  1.  S:CTYPE'="" L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="                Claim Type: "_CTYPE
  1.  D ENDREC(13)
  1.  Q
  1.  ;
  1. 15(IBD) ; Process subscriber/patient data
  1.  ; Claim must have been referenced by a previous '10' level
  1.  ; INPUT:
  1.  ;   IBD must be passed by reference = entire message line
  1.  ;
  1.  ; OUTPUT:
  1.  ;      IBD("LINE") = The last line # populated in the message
  1.  ;
  1.  ;     ^TMP("IBMSG",$J,"CLAIM",claim #,line#)=formatted service dates
  1.  ;                                    ,"D",15,msg seq #)=
  1.  ;                                         subscr/patient raw data
  1.  ;
  1.  N ENTITY,DATA,IBCLM,IBIFN,IBNM,IBNUM,IBDFN,L
  1.  ;D STRTREC  ;JRA IB*2.0*650 ';'
  1.  D STRTREC Q:'IBIFN  ;JRA IB*2.0*650 QUIT if no claim IEN - If '0' will cause <UNDEFINED> below
  1.  ; quit if no claim number or no previous 'line 10' record
  1.  Q:$S(IBCLM="":1,1:'$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)))
  1.  S IBDFN=+$P(^DGCR(399,IBIFN,0),U,2)  ;JRA IB*2.0*650 If IBIFN=0 <UNDEFINED> will occur
  1.  S IBNM=$S($P(IBD,U,3)'="":$P(IBD,U,3)_","_$P(IBD,U,4)_$S($P(IBD,U,5)'="":" "_$P(IBD,U,5),1:""),1:$P($G(^DPT(IBDFN,0)),U))
  1.  S IBNUM=$S($P(IBD,U,6)'="":$P(IBD,U,6),1:$P($G(^DPT(IBDFN,0)),U,9))
  1.  S L=L+1,^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Patient: "_IBNM_"   "_IBNUM
  1.  I $P(IBD,U,11) D
  1.  .S DATA=$$DATE($P(IBD,U,11)),L=L+1
  1.  .S ^TMP("IBMSG",$J,ENTITY,IBCLM,L)="Service Dates: "_DATA_" - "_$S($P(IBD,U,12):$$DATE($P(IBD,U,12)),1:DATA)
  1.  .Q
  1.  D ENDREC(15)
  1.  Q
  1.  ;
  1. STRTREC ; start processing of the record
  1.  ;           
  1.  ; OUTPUT:
  1.  ;   sets the following variables
  1.  ;   IBCLM = claim #
  1.  ;   ENTITY = "CLAIM" (all 277STAT messages are on claim level)
  1.  ;   L = last populated line number
  1.  ;
  1.  S IBCLM=$$GETCLM($P(IBD,U,2)),ENTITY="CLAIM",L=+$G(IBD("LINE"))
  1.  S IBIFN=+$O(^DGCR(399,"B",IBCLM,0))
  1.  Q
  1.  ;
  1. ENDREC(TYPE) ; finish processing of the record
  1.  ; INPUT:
  1.  ;   TYPE = record type (line type)
  1.  ;   
  1.  ; OUTPUT:
  1.  ;   IBD("LINE") = is updated with last populated line number
  1.  ;
  1.  ;make sure all variables are set properly
  1.  Q:$G(ENTITY)=""
  1.  Q:$G(IBCLM)=""
  1.  Q:$G(TYPE)=""
  1.  ; file raw data
  1.  S ^TMP("IBMSG",$J,ENTITY,IBCLM,"D",TYPE,$O(^TMP("IBMSG",$J,ENTITY,IBCLM,"D",TYPE,""),-1)+1)="##RAW DATA: "_IBD
  1.  ; update line count
  1.  ;;JWS;IB*2.0*665;EBILL-2164;was adding L, should have been setting it =
  1.  S IBD("LINE")=L
  1.  Q
  1.  ;
  1. GETBILL(CLAIM) ; Extract transmission #
  1.  N PREC,STATUS,TRANS
  1.  S TRANS=$$LAST364^IBCEF4(IBIFN),PREC=0
  1.  ; if status of the last transmission is "X" or "P", keep searching backwards through file 364 until record
  1.  ; with different status is found; if there's only one "P" record present, save it off in PREC
  1.  I TRANS F  S STATUS=$P(^IBA(364,TRANS,0),U,3) Q:"XP"'[STATUS  S:STATUS="P" PREC=$S(PREC=0:+TRANS,1:-1) S TRANS=$O(^IBA(364,"B",IBIFN,TRANS),-1) Q:TRANS=""  ;
  1.  ; if we didn't find any good records, and there's only one "P" record present, use this "P" record
  1.  I TRANS="",PREC>0 S TRANS=PREC
  1.  Q +TRANS
  1.  ;
  1. DATE(DT) ; Convert YYMMDD Date into MM/DD/YY or YYYYMMDD into MM/DD/YYYY
  1.  N D,Y
  1.  S D=DT,Y=""
  1.  I $L(DT)=8 S D=$E(DT,3,8),Y=$E(DT,1,2)
  1.  Q ($E(D,3,4)_"/"_$E(D,5,6)_"/"_Y_$E(D,1,2))
  1.  ;
  1. GETCLM(X) ; Extract the claim # without site id from the data in X
  1.  N IBCLM
  1.  S IBCLM=$P(X,"-",2) I IBCLM="",X'="" S IBCLM=$E(X,$S($L(X)>7:4,1:1),$L(X))
  1.  Q IBCLM
  1.  ;