IBCEDC ;ALB/ESG - EDI CLAIM STATUS REPORT COMPILE ;13-DEC-2007
;;2.0;INTEGRATED BILLING;**377,727**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; Compile entry point - Queued Job Entry Point
NEW BCHIEN,COUNT,DT1,DT2,IBIFN,IBLTRDT,IEN
K ^TMP($J,"IBCEDC")
I '$D(ZTQUEUED) W !!,"Compiling EDI Claim Status Report. Please wait "
;
I IBMETHOD="C" G EN1 ; specific claims selected
;
; get dates and loop thru ALT area
S DT1=$G(^TMP($J,"IBCEDS","ALTDT"))
S DT2=$P(DT1,U,2),DT1=$P(DT1,U,1)
S IBLTRDT=$O(^IBA(364.1,"ALT",DT1),-1) ; get starting point
F S IBLTRDT=$O(^IBA(364.1,"ALT",IBLTRDT)) Q:'IBLTRDT!(IBLTRDT\1>DT2)!$G(ZTSTOP) D
. S BCHIEN=0
. F S BCHIEN=$O(^IBA(364.1,"ALT",IBLTRDT,BCHIEN)) Q:'BCHIEN!$G(ZTSTOP) D
.. S IEN=0
.. F S IEN=$O(^IBA(364,"C",BCHIEN,IEN)) Q:'IEN!$G(ZTSTOP) D COMPILE(IEN)
.. Q
. Q
G RPT
;
;
EN1 ; specific claims selected so loop thru all EDI claims in file 364
; for these claims
;
S IBIFN=0
F S IBIFN=$O(^TMP($J,"IBCEDS","CLAIM",IBIFN)) Q:'IBIFN!$G(ZTSTOP) D
. S IEN=0
. F S IEN=$O(^IBA(364,"B",IBIFN,IEN)) Q:'IEN!$G(ZTSTOP) D
.. S BCHIEN=+$P($G(^IBA(364,IEN,0)),U,2) ; batch ien
.. S IBLTRDT=$P($G(^IBA(364.1,BCHIEN,1)),U,3) ; date/time last transmitted
.. D COMPILE(IEN)
.. Q
. Q
G RPT
;
;
RPT ; print the report and close things down
D PRINT^IBCEDP ; print report
D ^%ZISC ; close the device
K ^TMP($J,"IBCEDS"),^TMP($J,"IBCEDC") ; clean up scratch globals
I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
;
EX ; routine exit point
;
Q
;
COMPILE(IEN) ; gather and compile EDI claim data for one EDI claim
; IEN - 364 ien
NEW AR,DIV,IB0,IBAGE,IBAGEDT,IBARSTAT,IBCURBAL,IBDIV,IBDIVID,IBEDIST
NEW IBEXTCLM,IBIFN,IBPAY,IBS,IBSGD,IBSTAT,IBZ,INS,STAT,SV1,SV2,SV3
S COUNT=$G(COUNT)+1
I COUNT#1000=0 D I $G(ZTSTOP) G COMPX
. I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q ; check for TM stop request
. I '$D(ZTQUEUED) W "." ; display progress indicator
. Q
S IBZ=$G(^IBA(364,IEN,0)) I IBZ="" G COMPX
;;JWS;IB*2.0*727;EBILL-2680;in production accounts, skip over claims that were transmitted in TEST status
I $$PROD^XUPROD(1),$P(IBZ,U,7)=1 Q
;;JWS;IB*2.0*727;EBILL-2680;in non-production accounts, skip over claims that were transmitted in TEST status, if desired by user
I '$$PROD^XUPROD(1),$G(^TMP($J,"IBCEDS","TEST"))=0,$P(IBZ,U,7)=1 Q
S IBIFN=+IBZ
S IB0=$G(^DGCR(399,IBIFN,0)) I IB0="" G COMPX
S DIV=+$P(IB0,U,22) ; division ien
S INS=+$$FINDINS^IBCEF1(IBIFN,$P(IBZ,U,8)) ; insurance company ien for this EDI transmission
S STAT=$P(IBZ,U,3) ; edi status code
S AR=$P($$BILL^RCJIBFN2(IBIFN),U,2) ; current AR status ien
S IBARSTAT=$P($G(^PRCA(430.3,AR,0)),U,2) ; current AR status abbr/sort value
;
I IBMETHOD="R",'$$CHECK(IB0,DIV,INS,STAT,IBARSTAT) G COMPX ; failed selection criteria checks
;
S IBPAY=$P($G(^DIC(36,INS,0)),U,1)_U_INS ; payer name^insurance company ien
S IBDIVID=$P($G(^DG(40.8,DIV,0)),U,2) ; division id#
S IBDIV=IBDIVID ; division sort value
S IBEXTCLM=$P(IB0,U,1) ; claim#
S IBEDIST=STAT ; edi status sort value
S IBCURBAL=$G(^DGCR(399,IBIFN,"U1"))
S IBCURBAL=$P(IBCURBAL,U,1)-$P(IBCURBAL,U,2) ; current balance (total charges - offset)
;
; calculate age
S IBS=$G(^DGCR(399,IBIFN,"S"))
; if the payer is Medicare and an MRA request date exists then use that date
I $$MCRWNR^IBEFUNC(INS),$P(IBS,U,7) S IBAGEDT=$P(IBS,U,7)
E S IBAGEDT=$P(IBS,U,10) ; otherwise use the Authorization Date
I 'IBAGEDT S IBAGEDT=$P(IBS,U,1) ; if error, use date entered
I 'IBAGEDT S IBAGEDT=$P($G(^DGCR(399,IBIFN,"U")),U,1) ; if error again, use from date on claim
S IBAGE=$$FMDIFF^XLFDT(DT,IBAGEDT)
;
; capture IB status abbr
S IBSTAT=$P(IB0,U,13)
S IBSTAT=$S(IBSTAT=2:"REQ MRA",IBSTAT=4:"PRNT/TX",IBSTAT=7:"CANCEL",1:$$EXTERNAL^DILFD(399,.13,,IBSTAT))
;
; Build the scratch global
S IBSGD=IBEXTCLM_U_$$FT^IBCEF(IBIFN)_U_$$INPAT^IBCEF(IBIFN)_U_$P(IBZ,U,8)_U_STAT_U_IBLTRDT_U_IBAGE_U_+$P(IBZ,U,2)
S IBSGD=IBSGD_U_IBCURBAL_U_DIV_U_IBARSTAT_U_INS_U_IBSTAT
S SV1=$$SV^IBCEDS1($G(IBSORT1),IEN)
S SV2=$$SV^IBCEDS1($G(IBSORT2),IEN)
S SV3=$$SV^IBCEDS1($G(IBSORT3),IEN)
S ^TMP($J,"IBCEDC",SV1,SV2,SV3,IEN)=IBSGD
;
COMPX ;
Q
;
CHECK(IB0,DIV,INS,STAT,IBARSTAT) ; check to see if EDI claim passes the selection criteria
; function value =1 if passed checks
; function value =0 if failed checks
NEW OK,EDI,PROFID,INSTID S OK=0
I STAT="" S STAT="~~~~"
I $D(^TMP($J,"IBCEDS","DIV")),'$D(^TMP($J,"IBCEDS","DIV",DIV)) S OK=0 G CHECKX ; division check
I $D(^TMP($J,"IBCEDS","EDI")),'$D(^TMP($J,"IBCEDS","EDI",STAT)) S OK=0 G CHECKX ; EDI status check
;
; IB cancelled claim check
I $P(IB0,U,13)=7,'$G(^TMP($J,"IBCEDS","CANCEL")) S OK=0 G CHECKX
;
; AR cancelled claim check
I $F(".CB.CN.","."_IBARSTAT_"."),'$G(^TMP($J,"IBCEDS","CANCEL")) S OK=0 G CHECKX
;
; payer check
I $D(^TMP($J,"IBCEDS","INS")) D I 'OK G CHECKX
. S OK=0
. I 'INS Q ; don't include if the payer isn't valid
. I $D(^TMP($J,"IBCEDS","INS",1,INS)) S OK=1 Q
. I '$D(^TMP($J,"IBCEDS","INS",2)) Q
. S EDI=$$UP^XLFSTR($G(^DIC(36,INS,3)))
. S PROFID=$P(EDI,U,2),INSTID=$P(EDI,U,4)
. I PROFID'="",$D(^TMP($J,"IBCEDS","INS",2,PROFID)) S OK=1 Q
. I INSTID'="",$D(^TMP($J,"IBCEDS","INS",2,INSTID)) S OK=1 Q
. Q
;
; all checks passed OK
S OK=1
;
CHECKX ;
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEDC 5730 printed Apr 09, 2024@21:33 Page 2
IBCEDC ;ALB/ESG - EDI CLAIM STATUS REPORT COMPILE ;13-DEC-2007
+1 ;;2.0;INTEGRATED BILLING;**377,727**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; Compile entry point - Queued Job Entry Point
+1 NEW BCHIEN,COUNT,DT1,DT2,IBIFN,IBLTRDT,IEN
+2 KILL ^TMP($JOB,"IBCEDC")
+3 IF '$DATA(ZTQUEUED)
WRITE !!,"Compiling EDI Claim Status Report. Please wait "
+4 ;
+5 ; specific claims selected
IF IBMETHOD="C"
GOTO EN1
+6 ;
+7 ; get dates and loop thru ALT area
+8 SET DT1=$GET(^TMP($JOB,"IBCEDS","ALTDT"))
+9 SET DT2=$PIECE(DT1,U,2)
SET DT1=$PIECE(DT1,U,1)
+10 ; get starting point
SET IBLTRDT=$ORDER(^IBA(364.1,"ALT",DT1),-1)
+11 FOR
SET IBLTRDT=$ORDER(^IBA(364.1,"ALT",IBLTRDT))
if 'IBLTRDT!(IBLTRDT\1>DT2)!$GET(ZTSTOP)
QUIT
Begin DoDot:1
+12 SET BCHIEN=0
+13 FOR
SET BCHIEN=$ORDER(^IBA(364.1,"ALT",IBLTRDT,BCHIEN))
if 'BCHIEN!$GET(ZTSTOP)
QUIT
Begin DoDot:2
+14 SET IEN=0
+15 FOR
SET IEN=$ORDER(^IBA(364,"C",BCHIEN,IEN))
if 'IEN!$GET(ZTSTOP)
QUIT
DO COMPILE(IEN)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 GOTO RPT
+19 ;
+20 ;
EN1 ; specific claims selected so loop thru all EDI claims in file 364
+1 ; for these claims
+2 ;
+3 SET IBIFN=0
+4 FOR
SET IBIFN=$ORDER(^TMP($JOB,"IBCEDS","CLAIM",IBIFN))
if 'IBIFN!$GET(ZTSTOP)
QUIT
Begin DoDot:1
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^IBA(364,"B",IBIFN,IEN))
if 'IEN!$GET(ZTSTOP)
QUIT
Begin DoDot:2
+7 ; batch ien
SET BCHIEN=+$PIECE($GET(^IBA(364,IEN,0)),U,2)
+8 ; date/time last transmitted
SET IBLTRDT=$PIECE($GET(^IBA(364.1,BCHIEN,1)),U,3)
+9 DO COMPILE(IEN)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 GOTO RPT
+13 ;
+14 ;
RPT ; print the report and close things down
+1 ; print report
DO PRINT^IBCEDP
+2 ; close the device
DO ^%ZISC
+3 ; clean up scratch globals
KILL ^TMP($JOB,"IBCEDS"),^TMP($JOB,"IBCEDC")
+4 ; purge the task record
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 ;
EX ; routine exit point
+1 ;
+2 QUIT
+3 ;
COMPILE(IEN) ; gather and compile EDI claim data for one EDI claim
+1 ; IEN - 364 ien
+2 NEW AR,DIV,IB0,IBAGE,IBAGEDT,IBARSTAT,IBCURBAL,IBDIV,IBDIVID,IBEDIST
+3 NEW IBEXTCLM,IBIFN,IBPAY,IBS,IBSGD,IBSTAT,IBZ,INS,STAT,SV1,SV2,SV3
+4 SET COUNT=$GET(COUNT)+1
+5 IF COUNT#1000=0
Begin DoDot:1
+6 ; check for TM stop request
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+7 ; display progress indicator
IF '$DATA(ZTQUEUED)
WRITE "."
+8 QUIT
End DoDot:1
IF $GET(ZTSTOP)
GOTO COMPX
+9 SET IBZ=$GET(^IBA(364,IEN,0))
IF IBZ=""
GOTO COMPX
+10 ;;JWS;IB*2.0*727;EBILL-2680;in production accounts, skip over claims that were transmitted in TEST status
+11 IF $$PROD^XUPROD(1)
IF $PIECE(IBZ,U,7)=1
QUIT
+12 ;;JWS;IB*2.0*727;EBILL-2680;in non-production accounts, skip over claims that were transmitted in TEST status, if desired by user
+13 IF '$$PROD^XUPROD(1)
IF $GET(^TMP($JOB,"IBCEDS","TEST"))=0
IF $PIECE(IBZ,U,7)=1
QUIT
+14 SET IBIFN=+IBZ
+15 SET IB0=$GET(^DGCR(399,IBIFN,0))
IF IB0=""
GOTO COMPX
+16 ; division ien
SET DIV=+$PIECE(IB0,U,22)
+17 ; insurance company ien for this EDI transmission
SET INS=+$$FINDINS^IBCEF1(IBIFN,$PIECE(IBZ,U,8))
+18 ; edi status code
SET STAT=$PIECE(IBZ,U,3)
+19 ; current AR status ien
SET AR=$PIECE($$BILL^RCJIBFN2(IBIFN),U,2)
+20 ; current AR status abbr/sort value
SET IBARSTAT=$PIECE($GET(^PRCA(430.3,AR,0)),U,2)
+21 ;
+22 ; failed selection criteria checks
IF IBMETHOD="R"
IF '$$CHECK(IB0,DIV,INS,STAT,IBARSTAT)
GOTO COMPX
+23 ;
+24 ; payer name^insurance company ien
SET IBPAY=$PIECE($GET(^DIC(36,INS,0)),U,1)_U_INS
+25 ; division id#
SET IBDIVID=$PIECE($GET(^DG(40.8,DIV,0)),U,2)
+26 ; division sort value
SET IBDIV=IBDIVID
+27 ; claim#
SET IBEXTCLM=$PIECE(IB0,U,1)
+28 ; edi status sort value
SET IBEDIST=STAT
+29 SET IBCURBAL=$GET(^DGCR(399,IBIFN,"U1"))
+30 ; current balance (total charges - offset)
SET IBCURBAL=$PIECE(IBCURBAL,U,1)-$PIECE(IBCURBAL,U,2)
+31 ;
+32 ; calculate age
+33 SET IBS=$GET(^DGCR(399,IBIFN,"S"))
+34 ; if the payer is Medicare and an MRA request date exists then use that date
+35 IF $$MCRWNR^IBEFUNC(INS)
IF $PIECE(IBS,U,7)
SET IBAGEDT=$PIECE(IBS,U,7)
+36 ; otherwise use the Authorization Date
IF '$TEST
SET IBAGEDT=$PIECE(IBS,U,10)
+37 ; if error, use date entered
IF 'IBAGEDT
SET IBAGEDT=$PIECE(IBS,U,1)
+38 ; if error again, use from date on claim
IF 'IBAGEDT
SET IBAGEDT=$PIECE($GET(^DGCR(399,IBIFN,"U")),U,1)
+39 SET IBAGE=$$FMDIFF^XLFDT(DT,IBAGEDT)
+40 ;
+41 ; capture IB status abbr
+42 SET IBSTAT=$PIECE(IB0,U,13)
+43 SET IBSTAT=$SELECT(IBSTAT=2:"REQ MRA",IBSTAT=4:"PRNT/TX",IBSTAT=7:"CANCEL",1:$$EXTERNAL^DILFD(399,.13,,IBSTAT))
+44 ;
+45 ; Build the scratch global
+46 SET IBSGD=IBEXTCLM_U_$$FT^IBCEF(IBIFN)_U_$$INPAT^IBCEF(IBIFN)_U_$PIECE(IBZ,U,8)_U_STAT_U_IBLTRDT_U_IBAGE_U_+$PIECE(IBZ,U,2)
+47 SET IBSGD=IBSGD_U_IBCURBAL_U_DIV_U_IBARSTAT_U_INS_U_IBSTAT
+48 SET SV1=$$SV^IBCEDS1($GET(IBSORT1),IEN)
+49 SET SV2=$$SV^IBCEDS1($GET(IBSORT2),IEN)
+50 SET SV3=$$SV^IBCEDS1($GET(IBSORT3),IEN)
+51 SET ^TMP($JOB,"IBCEDC",SV1,SV2,SV3,IEN)=IBSGD
+52 ;
COMPX ;
+1 QUIT
+2 ;
CHECK(IB0,DIV,INS,STAT,IBARSTAT) ; check to see if EDI claim passes the selection criteria
+1 ; function value =1 if passed checks
+2 ; function value =0 if failed checks
+3 NEW OK,EDI,PROFID,INSTID
SET OK=0
+4 IF STAT=""
SET STAT="~~~~"
+5 ; division check
IF $DATA(^TMP($JOB,"IBCEDS","DIV"))
IF '$DATA(^TMP($JOB,"IBCEDS","DIV",DIV))
SET OK=0
GOTO CHECKX
+6 ; EDI status check
IF $DATA(^TMP($JOB,"IBCEDS","EDI"))
IF '$DATA(^TMP($JOB,"IBCEDS","EDI",STAT))
SET OK=0
GOTO CHECKX
+7 ;
+8 ; IB cancelled claim check
+9 IF $PIECE(IB0,U,13)=7
IF '$GET(^TMP($JOB,"IBCEDS","CANCEL"))
SET OK=0
GOTO CHECKX
+10 ;
+11 ; AR cancelled claim check
+12 IF $FIND(".CB.CN.","."_IBARSTAT_".")
IF '$GET(^TMP($JOB,"IBCEDS","CANCEL"))
SET OK=0
GOTO CHECKX
+13 ;
+14 ; payer check
+15 IF $DATA(^TMP($JOB,"IBCEDS","INS"))
Begin DoDot:1
+16 SET OK=0
+17 ; don't include if the payer isn't valid
IF 'INS
QUIT
+18 IF $DATA(^TMP($JOB,"IBCEDS","INS",1,INS))
SET OK=1
QUIT
+19 IF '$DATA(^TMP($JOB,"IBCEDS","INS",2))
QUIT
+20 SET EDI=$$UP^XLFSTR($GET(^DIC(36,INS,3)))
+21 SET PROFID=$PIECE(EDI,U,2)
SET INSTID=$PIECE(EDI,U,4)
+22 IF PROFID'=""
IF $DATA(^TMP($JOB,"IBCEDS","INS",2,PROFID))
SET OK=1
QUIT
+23 IF INSTID'=""
IF $DATA(^TMP($JOB,"IBCEDS","INS",2,INSTID))
SET OK=1
QUIT
+24 QUIT
End DoDot:1
IF 'OK
GOTO CHECKX
+25 ;
+26 ; all checks passed OK
+27 SET OK=1
+28 ;
CHECKX ;
+1 QUIT OK
+2 ;
