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

IBCEDC.m

Go to the documentation of this file. 
  1. IBCEDC ;ALB/ESG - EDI CLAIM STATUS REPORT COMPILE ;13-DEC-2007
  1.  ;;2.0;INTEGRATED BILLING;**377,727**;21-MAR-94;Build 34
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. EN ; Compile entry point - Queued Job Entry Point
  1.  NEW BCHIEN,COUNT,DT1,DT2,IBIFN,IBLTRDT,IEN
  1.  K ^TMP($J,"IBCEDC")
  1.  I '$D(ZTQUEUED) W !!,"Compiling EDI Claim Status Report.  Please wait "
  1.  ;
  1.  I IBMETHOD="C" G EN1     ; specific claims selected
  1.  ;
  1.  ; get dates and loop thru ALT area
  1.  S DT1=$G(^TMP($J,"IBCEDS","ALTDT"))
  1.  S DT2=$P(DT1,U,2),DT1=$P(DT1,U,1)
  1.  S IBLTRDT=$O(^IBA(364.1,"ALT",DT1),-1)  ; get starting point
  1.  F  S IBLTRDT=$O(^IBA(364.1,"ALT",IBLTRDT)) Q:'IBLTRDT!(IBLTRDT\1>DT2)!$G(ZTSTOP)  D
  1.  . S BCHIEN=0
  1.  . F  S BCHIEN=$O(^IBA(364.1,"ALT",IBLTRDT,BCHIEN)) Q:'BCHIEN!$G(ZTSTOP)  D
  1.  .. S IEN=0
  1.  .. F  S IEN=$O(^IBA(364,"C",BCHIEN,IEN)) Q:'IEN!$G(ZTSTOP)  D COMPILE(IEN)
  1.  .. Q
  1.  . Q
  1.  G RPT
  1.  ;
  1.  ;
  1. EN1 ; specific claims selected so loop thru all EDI claims in file 364
  1.  ; for these claims
  1.  ;
  1.  S IBIFN=0
  1.  F  S IBIFN=$O(^TMP($J,"IBCEDS","CLAIM",IBIFN)) Q:'IBIFN!$G(ZTSTOP)  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^IBA(364,"B",IBIFN,IEN)) Q:'IEN!$G(ZTSTOP)  D
  1.  .. S BCHIEN=+$P($G(^IBA(364,IEN,0)),U,2)         ; batch ien
  1.  .. S IBLTRDT=$P($G(^IBA(364.1,BCHIEN,1)),U,3)    ; date/time last transmitted
  1.  .. D COMPILE(IEN)
  1.  .. Q
  1.  . Q
  1.  G RPT
  1.  ;
  1.  ;
  1. RPT ; print the report and close things down
  1.  D PRINT^IBCEDP                          ; print report
  1.  D ^%ZISC                                ; close the device
  1.  K ^TMP($J,"IBCEDS"),^TMP($J,"IBCEDC")   ; clean up scratch globals
  1.  I $D(ZTQUEUED) S ZTREQ="@"              ; purge the task record
  1.  ;
  1. EX ; routine exit point
  1.  ;
  1.  Q
  1.  ;
  1. COMPILE(IEN) ; gather and compile EDI claim data for one EDI claim
  1.  ; IEN - 364 ien
  1.  NEW AR,DIV,IB0,IBAGE,IBAGEDT,IBARSTAT,IBCURBAL,IBDIV,IBDIVID,IBEDIST
  1.  NEW IBEXTCLM,IBIFN,IBPAY,IBS,IBSGD,IBSTAT,IBZ,INS,STAT,SV1,SV2,SV3
  1.  S COUNT=$G(COUNT)+1
  1.  I COUNT#1000=0 D  I $G(ZTSTOP) G COMPX
  1.  . I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q   ; check for TM stop request
  1.  . I '$D(ZTQUEUED) W "."                       ; display progress indicator
  1.  . Q
  1.  S IBZ=$G(^IBA(364,IEN,0)) I IBZ="" G COMPX
  1.  ;;JWS;IB*2.0*727;EBILL-2680;in production accounts, skip over claims that were transmitted in TEST status
  1.  I $$PROD^XUPROD(1),$P(IBZ,U,7)=1 Q
  1.  ;;JWS;IB*2.0*727;EBILL-2680;in non-production accounts, skip over claims that were transmitted in TEST status, if desired by user
  1.  I '$$PROD^XUPROD(1),$G(^TMP($J,"IBCEDS","TEST"))=0,$P(IBZ,U,7)=1 Q
  1.  S IBIFN=+IBZ
  1.  S IB0=$G(^DGCR(399,IBIFN,0)) I IB0="" G COMPX
  1.  S DIV=+$P(IB0,U,22)                           ; division ien
  1.  S INS=+$$FINDINS^IBCEF1(IBIFN,$P(IBZ,U,8))    ; insurance company ien for this EDI transmission
  1.  S STAT=$P(IBZ,U,3)                            ; edi status code
  1.  S AR=$P($$BILL^RCJIBFN2(IBIFN),U,2)           ; current AR status ien
  1.  S IBARSTAT=$P($G(^PRCA(430.3,AR,0)),U,2)      ; current AR status abbr/sort value
  1.  ;
  1.  I IBMETHOD="R",'$$CHECK(IB0,DIV,INS,STAT,IBARSTAT) G COMPX   ; failed selection criteria checks
  1.  ;
  1.  S IBPAY=$P($G(^DIC(36,INS,0)),U,1)_U_INS  ; payer name^insurance company ien
  1.  S IBDIVID=$P($G(^DG(40.8,DIV,0)),U,2)     ; division id#
  1.  S IBDIV=IBDIVID                           ; division sort value
  1.  S IBEXTCLM=$P(IB0,U,1)                    ; claim#
  1.  S IBEDIST=STAT                            ; edi status sort value
  1.  S IBCURBAL=$G(^DGCR(399,IBIFN,"U1"))
  1.  S IBCURBAL=$P(IBCURBAL,U,1)-$P(IBCURBAL,U,2)   ; current balance (total charges - offset)
  1.  ;
  1.  ; calculate age
  1.  S IBS=$G(^DGCR(399,IBIFN,"S"))
  1.  ; if the payer is Medicare and an MRA request date exists then use that date
  1.  I $$MCRWNR^IBEFUNC(INS),$P(IBS,U,7) S IBAGEDT=$P(IBS,U,7)
  1.  E  S IBAGEDT=$P(IBS,U,10)     ; otherwise use the Authorization Date
  1.  I 'IBAGEDT S IBAGEDT=$P(IBS,U,1)   ; if error, use date entered
  1.  I 'IBAGEDT S IBAGEDT=$P($G(^DGCR(399,IBIFN,"U")),U,1)    ; if error again, use from date on claim
  1.  S IBAGE=$$FMDIFF^XLFDT(DT,IBAGEDT)
  1.  ;
  1.  ; capture IB status abbr
  1.  S IBSTAT=$P(IB0,U,13)
  1.  S IBSTAT=$S(IBSTAT=2:"REQ MRA",IBSTAT=4:"PRNT/TX",IBSTAT=7:"CANCEL",1:$$EXTERNAL^DILFD(399,.13,,IBSTAT))
  1.  ;
  1.  ; Build the scratch global
  1.  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)
  1.  S IBSGD=IBSGD_U_IBCURBAL_U_DIV_U_IBARSTAT_U_INS_U_IBSTAT
  1.  S SV1=$$SV^IBCEDS1($G(IBSORT1),IEN)
  1.  S SV2=$$SV^IBCEDS1($G(IBSORT2),IEN)
  1.  S SV3=$$SV^IBCEDS1($G(IBSORT3),IEN)
  1.  S ^TMP($J,"IBCEDC",SV1,SV2,SV3,IEN)=IBSGD
  1.  ;
  1. COMPX ;
  1.  Q
  1.  ;
  1. CHECK(IB0,DIV,INS,STAT,IBARSTAT) ; check to see if EDI claim passes the selection criteria
  1.  ; function value =1 if passed checks
  1.  ; function value =0 if failed checks
  1.  NEW OK,EDI,PROFID,INSTID S OK=0
  1.  I STAT="" S STAT="~~~~"
  1.  I $D(^TMP($J,"IBCEDS","DIV")),'$D(^TMP($J,"IBCEDS","DIV",DIV)) S OK=0 G CHECKX    ; division check
  1.  I $D(^TMP($J,"IBCEDS","EDI")),'$D(^TMP($J,"IBCEDS","EDI",STAT)) S OK=0 G CHECKX   ; EDI status check
  1.  ;
  1.  ; IB cancelled claim check
  1.  I $P(IB0,U,13)=7,'$G(^TMP($J,"IBCEDS","CANCEL")) S OK=0 G CHECKX
  1.  ;
  1.  ; AR cancelled claim check
  1.  I $F(".CB.CN.","."_IBARSTAT_"."),'$G(^TMP($J,"IBCEDS","CANCEL")) S OK=0 G CHECKX
  1.  ;
  1.  ; payer check
  1.  I $D(^TMP($J,"IBCEDS","INS")) D  I 'OK G CHECKX
  1.  . S OK=0
  1.  . I 'INS Q   ; don't include if the payer isn't valid
  1.  . I $D(^TMP($J,"IBCEDS","INS",1,INS)) S OK=1 Q
  1.  . I '$D(^TMP($J,"IBCEDS","INS",2)) Q
  1.  . S EDI=$$UP^XLFSTR($G(^DIC(36,INS,3)))
  1.  . S PROFID=$P(EDI,U,2),INSTID=$P(EDI,U,4)
  1.  . I PROFID'="",$D(^TMP($J,"IBCEDS","INS",2,PROFID)) S OK=1 Q
  1.  . I INSTID'="",$D(^TMP($J,"IBCEDS","INS",2,INSTID)) S OK=1 Q
  1.  . Q
  1.  ;
  1.  ; all checks passed OK
  1.  S OK=1
  1.  ;
  1. CHECKX ;
  1.  Q OK
  1.  ;