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