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

IBCEPTR.m

Go to the documentation of this file. 
  1. IBCEPTR ;ALB/ESG - Test Claim Messages Report ;28-JAN-2005
  1.  ;;2.0;INTEGRATED BILLING;**296,320,348,349,592**;21-MAR-94;Build 58
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; eClaims Plus
  1.  ; Report on Test Claim Transmissions and Status Messages
  1.  ;
  1. EN ; Entry Point
  1.  NEW STOP,IBRMETH,IBRDATA
  1.  D SELECT I STOP G EXIT
  1.  D DEVICE
  1. EXIT ; Exit Point
  1.  Q
  1.  ;
  1. SELECT ; Determine which claim#'s or batch#'s to report on
  1.  NEW DIC,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,D
  1.  S STOP=0
  1.  W @IOF
  1.  W !!?23,"Test Claim EDI Transmission Report"
  1.  W !!?7,"This report will display EDI transmission data and returned status"
  1.  W !?7,"message data for selected test claims.  You may select test claims"
  1.  W !?7,"by claim number or by batch number or you may search for claims that"
  1.  W !?7,"were transmitted within a date range.",!
  1.  S DIR(0)="SO^C:Claim;B:Batch;D:Date Range (Date Transmitted)"
  1.  S DIR("A")="Selection Method",DIR("B")="D"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G SELECTX
  1.  S IBRMETH=Y
  1.  I IBRMETH'="C",IBRMETH'="B",IBRMETH'="D" S STOP=1 G SELECTX
  1.  ;
  1.  K IBRDATA
  1.  I IBRMETH="C" D
  1.  . F  D  Q:Y'>0
  1.  .. W !
  1.  .. S DIC("A")="Test Claim: "
  1.  .. I $O(IBRDATA("")) S DIC("A")="Another Test Claim: "
  1.  .. S DIC("W")="D CLMLST^IBCEPTR(Y)"
  1.  .. S DIC=361.4,DIC(0)="AEMQ",D="B" D MIX^DIC1
  1.  .. Q:Y'>0
  1.  .. S IBRDATA(+Y)=""
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I IBRMETH="B" D
  1.  . F  D  Q:Y'>0
  1.  .. W !
  1.  .. S DIC("A")="Test Batch: "
  1.  .. I $O(IBRDATA("")) S DIC("A")="Another Test Batch: "
  1.  .. S DIC("S")="I $P(^(0),U,14),$O(^IBM(361.4,""C"",+Y,0))"
  1.  .. S DIC=364.1,DIC(0)="AEMQ",D="B^C" D MIX^DIC1
  1.  .. Q:Y'>0
  1.  .. S IBRDATA(+Y)=""
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I IBRMETH="D" D
  1.  . W !
  1.  . S DIR(0)="DAO^:"_DT_":AEX",DIR("A")="  Earliest Date Claims Transmitted: "
  1.  . D ^DIR K DIR
  1.  . I $D(DIRUT)!'Y Q
  1.  . S IBRDATA(1)=Y
  1.  . W !
  1.  . S DIR(0)="DAO^"_Y_":"_DT_":AEX",DIR("A")="    Latest Date Claims Transmitted: ",DIR("B")="Today"
  1.  . D ^DIR K DIR
  1.  . I $D(DIRUT)!'Y Q
  1.  . S IBRDATA(2)=Y
  1.  . Q
  1.  ;
  1.  I '$O(IBRDATA("")) S STOP=1 G SELECTX
  1.  I IBRMETH="D",'$G(IBRDATA(1)) S STOP=1 G SELECTX
  1.  I IBRMETH="D",'$G(IBRDATA(2)) S STOP=1 G SELECTX
  1.  ;
  1. SELECTX ;
  1.  Q
  1.  ;
  1. DEVICE ; standard device selection
  1.  NEW ZTRTN,ZTDESC,ZTSAVE,POP
  1.  W !!!,"This report is 80 characters wide.",!
  1.  S ZTRTN="COMPILE^IBCEPTR"
  1.  S ZTDESC="Test Claim EDI Transmission Report"
  1.  S ZTSAVE("IBRMETH")=""
  1.  S ZTSAVE("IBRDATA")=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
  1. DEVX ;
  1.  Q
  1.  ;
  1. COMPILE ; compile the data into a scratch global
  1.  NEW RTN,EXTBCH,IBIFN,BCHIEN,TXDATM
  1.  S RTN="IBCEPTR"
  1.  KILL ^TMP($J,RTN)  ; init scratch global
  1.  ;
  1.  I IBRMETH="C" D    ; claim search
  1.  . S EXTBCH=0
  1.  . S IBIFN=0
  1.  . F  S IBIFN=$O(IBRDATA(IBIFN)) Q:'IBIFN  D STORE(IBIFN)
  1.  . Q
  1.  ;
  1.  I IBRMETH="B" D    ; batch search
  1.  . S BCHIEN=0
  1.  . F  S BCHIEN=$O(IBRDATA(BCHIEN)) Q:'BCHIEN  D
  1.  .. S EXTBCH=$P($G(^IBA(364.1,BCHIEN,0)),U,1)
  1.  .. I EXTBCH="" S EXTBCH="~unknown"
  1.  .. S IBIFN=0
  1.  .. F  S IBIFN=$O(^IBM(361.4,"C",BCHIEN,IBIFN)) Q:'IBIFN  D STORE(IBIFN)
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I IBRMETH="D" D    ; date range search
  1.  . S EXTBCH=0
  1.  . S TXDATM=$O(^IBM(361.4,"ATD",IBRDATA(1)),-1)
  1.  . F  S TXDATM=$O(^IBM(361.4,"ATD",TXDATM)) Q:'TXDATM  Q:(TXDATM\1)>IBRDATA(2)  D
  1.  .. S IBIFN=0
  1.  .. F  S IBIFN=$O(^IBM(361.4,"ATD",TXDATM,IBIFN)) Q:'IBIFN  D STORE(IBIFN)
  1.  .. Q
  1.  . Q
  1.  ;
  1.  D PRINT                           ; print the report
  1.  D ^%ZISC                          ; close the device
  1.  KILL ^TMP($J,RTN)                 ; clean up scratch global
  1.  I $D(ZTQUEUED) S ZTREQ="@"        ; purge the task record
  1. COMPX ;
  1.  Q
  1.  ;
  1. STORE(IBIFN) ; Input = internal bill#; continue compilation
  1.  NEW IB0,CLAIM,IBRTXD0,TXIEN,SMIEN,DATA,TXDTM
  1.  S IB0=$G(^DGCR(399,IBIFN,0))
  1.  S CLAIM=$P(IB0,U,1)  ; external claim#
  1.  I CLAIM="" S CLAIM="~unknown"
  1.  S IBRTXD0=99999999   ; initial value for earliest transmission date
  1.  ;
  1.  I IBRMETH="C" D   ; claim search for transmission data (all)
  1.  . S TXIEN=0
  1.  . F  S TXIEN=$O(^IBM(361.4,IBIFN,1,TXIEN)) Q:'TXIEN  D STORETX(IBIFN,TXIEN)
  1.  . Q
  1.  ;
  1.  I IBRMETH="B" D   ; batch search for transmission data ("C" x-ref)
  1.  . S TXIEN=0
  1.  . F  S TXIEN=$O(^IBM(361.4,"C",BCHIEN,IBIFN,TXIEN)) Q:'TXIEN  D STORETX(IBIFN,TXIEN)
  1.  . Q
  1.  ;
  1.  I IBRMETH="D" D   ; date range search for transmission data ("ATD" xref)
  1.  . S TXIEN=0
  1.  . F  S TXIEN=$O(^IBM(361.4,"ATD",TXDATM,IBIFN,TXIEN)) Q:'TXIEN  D STORETX(IBIFN,TXIEN)
  1.  . Q
  1.  ;
  1.  ; loop thru all returned messages for claim
  1.  S SMIEN=0
  1.  F  S SMIEN=$O(^IBM(361.4,IBIFN,2,SMIEN)) Q:'SMIEN  D
  1.  . S DATA=$G(^IBM(361.4,IBIFN,2,SMIEN,0)) Q:DATA=""   ; received msg data
  1.  . S TXDTM=$P(DATA,U,1) Q:'TXDTM    ; msg rec'd date/time
  1.  . ;
  1.  . ; Batch only: if this status message was received before the
  1.  . ; earliest transmission for this batch, then don't include it
  1.  . I IBRMETH="B",TXDTM'>IBRTXD0 Q
  1.  . ;
  1.  . ; Date range search only:  make sure the date/time the status message
  1.  . ; was received is inside the user specified date range for this report
  1.  . I IBRMETH="D",(TXDTM\1)<IBRDATA(1) Q    ; rec'd too early
  1.  . I IBRMETH="D",(TXDTM\1)>IBRDATA(2) Q    ; rec'd too late
  1.  . ;
  1.  . ; store it
  1.  . M ^TMP($J,RTN,EXTBCH,CLAIM,TXDTM,2,SMIEN)=^IBM(361.4,IBIFN,2,SMIEN)
  1.  . Q
  1. STOREX ;
  1.  Q
  1.  ;
  1. STORETX(IBIFN,TXIEN) ; store transmission info
  1.  NEW DATA,TXDTM
  1.  S DATA=$G(^IBM(361.4,IBIFN,1,TXIEN,0))
  1.  I DATA="" G STTXXX
  1.  S TXDTM=$P(DATA,U,1)   ; transmit date/time
  1.  I 'TXDTM G STTXXX
  1.  I TXDTM<IBRTXD0 S IBRTXD0=TXDTM
  1.  ;
  1.  ; store it
  1.  M ^TMP($J,RTN,EXTBCH,CLAIM,TXDTM,1,TXIEN)=^IBM(361.4,IBIFN,1,TXIEN)
  1. STTXXX ;
  1.  Q
  1.  ;
  1. PRINT ; print the report to the specified device
  1.  NEW MAXCNT,CRT,PAGECNT,STOP,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
  1.  NEW BATCH,CLAIM,IBIFN,CLMD,TXD,TYPE,IEN
  1.  I IOST["C-" S MAXCNT=IOSL-3,CRT=1
  1.  E  S MAXCNT=IOSL-6,CRT=0
  1.  S PAGECNT=0,STOP=0
  1.  ;
  1.  I '$D(^TMP($J,RTN)) D HEADER W !!!?5,"No Data Found"
  1.  ;
  1.  S BATCH=""
  1.  F  S BATCH=$O(^TMP($J,RTN,BATCH)) Q:BATCH=""  D  Q:STOP
  1.  . D HEADER Q:STOP
  1.  . I BATCH'=0 W !!,"Batch#:  ",BATCH
  1.  . S CLAIM=""
  1.  . F  S CLAIM=$O(^TMP($J,RTN,BATCH,CLAIM)) Q:CLAIM=""  D  Q:STOP
  1.  .. I $Y+2>MAXCNT!'PAGECNT D HEADER Q:STOP
  1.  .. I BATCH=0 W !
  1.  .. W !,"Claim#:  ",CLAIM
  1.  .. S IBIFN=+$O(^DGCR(399,"B",CLAIM,""))
  1.  .. I IBIFN S CLMD=$$BT(IBIFN) W ?18,$E($P(CLMD,U,3),1,20),?40,"(",$P(CLMD,U,1),")"
  1.  .. W !,$$RJ^XLFSTR("",80,"-")
  1.  .. ;
  1.  .. S TXD=0
  1.  .. F  S TXD=$O(^TMP($J,RTN,BATCH,CLAIM,TXD)) Q:'TXD!STOP  S TYPE=0 F  S TYPE=$O(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE)) Q:'TYPE!STOP  S IEN=0 F  S IEN=$O(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN)) Q:'IEN!STOP  D  Q:STOP
  1.  ... I TYPE=1 D TXPRT
  1.  ... I TYPE=2 D SMPRT
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I STOP G PRINTX
  1.  I $Y+2>MAXCNT!'PAGECNT D HEADER I STOP G PRINTX
  1.  W !!?5,"*** End of Report ***"
  1.  I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
  1. PRINTX ;
  1.  Q
  1.  ;
  1. TXPRT ; print transmission information
  1.  NEW DATA,TXDTM,EXTBCH,TXBY,INSIEN,PAYER,PSEQ,INZ
  1.  S DATA=$G(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,0)) I DATA="" G TXPRTX
  1.  S TXDTM=$$FMTE^XLFDT($P(DATA,U,1),"5Z")
  1.  S EXTBCH=$$EXTERNAL^DILFD(361.41,.02,,$P(DATA,U,2))  ; batch
  1.  S TXBY=$$EXTERNAL^DILFD(361.41,.03,,$P(DATA,U,3))    ; who tx
  1.  S INSIEN=+$$FINDINS^IBCEF1(IBIFN,$P(DATA,U,4))       ; insurance
  1.  S INZ=$$INSADD^IBCNSC02(INSIEN)                      ; ins name/addr
  1.  S PAYER=$P(INZ,U,1)                                  ; ins name
  1.  S PSEQ=$TR($P(DATA,U,4),"123","PST")                 ; payer seq
  1.  ;
  1.  I $Y+2>MAXCNT!'PAGECNT D HEADER I STOP G TXPRTX
  1.  W !,"Transmission Information"
  1.  W !?1,TXDTM,?22,"Bch#",+$E(EXTBCH,4,99),?33,$E(TXBY,1,15),?50,$E(PAYER,1,20),"  (",PSEQ,")"
  1.  ; display address info if not Medicare
  1.  I '$$MCRWNR^IBEFUNC(INSIEN) W !?50,$E($P(INZ,U,2),1,15),",",$E($P(INZ,U,3),1,11),",",$E($P(INZ,U,4),1,2)
  1.  W !
  1. TXPRTX ;
  1.  Q
  1.  ;
  1. SMPRT ; print returned status message information
  1.  NEW DATA,TXDTM,SEVERITY,Z
  1.  S DATA=$G(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,0)) I DATA="" G SMPRTX
  1.  S TXDTM=$$FMTE^XLFDT($P(DATA,U,1),"5Z")
  1.  S SEVERITY=$$EXTERNAL^DILFD(361.42,.02,,$P(DATA,U,2))  ; msg severity
  1.  ;
  1.  I $Y+2>MAXCNT!'PAGECNT D HEADER I STOP G SMPRTX
  1.  W !,"Status Message Information"
  1.  W !?1,TXDTM,?22,SEVERITY,?65,"Msg#",$P(DATA,U,3)
  1.  S Z=0
  1.  F  S Z=$O(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,1,Z)) Q:'Z  D  Q:STOP
  1.  . I $Y+1>MAXCNT!'PAGECNT D HEADER Q:STOP
  1.  . W !?2,$G(^TMP($J,RTN,BATCH,CLAIM,TXD,TYPE,IEN,1,Z,0))
  1.  . Q
  1.  W !
  1. SMPRTX ;
  1.  Q
  1.  ;
  1.  NEW LIN,HDR,TAB
  1.  S STOP=0
  1.  I CRT,PAGECNT>0,'$D(ZTQUEUED) D  I STOP G HEADX
  1.  . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  . I 'Y S STOP=1 Q
  1.  . Q
  1.  ;
  1.  S PAGECNT=PAGECNT+1
  1.  W @IOF,!
  1.  ;
  1.  W "Test Claim EDI Transmission Report"
  1.  S HDR="Page: "_PAGECNT,TAB=80-$L(HDR)-1
  1.  W ?TAB,HDR
  1.  W !,"Selected ",$S(IBRMETH="B":"Batches",IBRMETH="C":"Claims",1:"Date Range")
  1.  S HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z"),TAB=80-$L(HDR)-1
  1.  W ?TAB,HDR
  1.  W !,$$RJ^XLFSTR("",80,"=")
  1.  ;
  1.  ; check for a stop request
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() D  G HEADX
  1.  . S (ZTSTOP,STOP)=1
  1.  . W !!!?5,"*** Report Halted by TaskManager Request ***"
  1.  . Q
  1.  ;
  1. HEADX ;
  1.  Q
  1.  ;
  1. BT(IBIFN) ; bill type and info
  1.  ; [1] TYPE (form type, charge type, inp/outp)
  1.  ; [2] claim#
  1.  ; [3] patient name
  1.  NEW TYPE,IB0,F,C,S S TYPE=""
  1.  S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" Q ""
  1.  ;S F=$P(IB0,U,19),F=$S(F=2:"1500",1:"UB04"))  ;JRA IB*2.0*592 ';'
  1.  S F=$P(IB0,U,19),F=$S(F=2:"1500",F=7:"J430D",1:"UB04")  ;JRA IB*2.0*592 Add Dental Form 'J430D'
  1.  S C=$P(IB0,U,27),C=$S(C=1:"Inst",1:"Prof")
  1.  S S=$$INPAT^IBCEF(IBIFN),S=$S(S=1:"Inpat",1:"Outpat")
  1.  S TYPE=F_", "_C_", "_S
  1.  Q TYPE_U_$P(IB0,U,1)_U_$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
  1.  ;
  1. CLMLST(IBIFN) ; DIC lister
  1.  NEW TYPE,LTD,N1,N2
  1.  S TYPE=$P($$BT(IBIFN),U,1)
  1.  S LTD=$$FMTE^XLFDT($P($G(^IBM(361.4,IBIFN,0)),U,2),"2Z")
  1.  S N1=+$P($G(^IBM(361.4,IBIFN,1,0)),U,4)  ; # transmissions
  1.  S N2=+$P($G(^IBM(361.4,IBIFN,2,0)),U,4)  ; # return messages
  1.  W " ",TYPE,?34," ",LTD,?45," ",N1," Transmission",$S(N1'=1:"s",1:"")
  1.  W ?63," ",N2," Message",$S(N2'=1:"s",1:"")
  1. CLMLSTX ;
  1.  Q
  1.  ;