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