IBCEPTC0 ;ALB/ESG - EDI PREVIOUSLY TRANSMITTED CLAIMS CONT ; 12/19/05
;;2.0;INTEGRATED BILLING;**320,348,547,592,665**;21-MAR-94;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
LIST ; Queued report format entrypoint
; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
; IBCRIT,IBPTCCAN,IBRCBFPC
; ^TMP("IB_PREV_CLAIM_INS,$J) global
K ^TMP("IB_PREV_CLAIM",$J)
N IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
N INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
I IBREP="R" N IBPAGE,IBSTOP,IBHDRDT S (IBPAGE,IBSTOP)=0
;
; evaluate claim transmission data from files 364.1 and 364
;WCJ;IB665;start;added times to date/times in IBCEPTC
;S IBDT=IBDT1-.1
S IBDT=$$FMADD^XLFDT(IBDT1,,,,-1)
I '+$P(IBDT2,".",2) S IBDT2=$$FMADD^XLFDT(IBDT2,1,,,-1)
;F S IBDT=$O(^IBA(364.1,"ALT",IBDT)) Q:'IBDT!((IBDT\1)>IBDT2) S IBBDA=0 F S IBBDA=$O(^IBA(364.1,"ALT",IBDT,IBBDA)) Q:'IBBDA D
F S IBDT=$O(^IBA(364.1,"ALT",IBDT)) Q:'IBDT!((IBDT)>IBDT2) S IBBDA=0 F S IBBDA=$O(^IBA(364.1,"ALT",IBDT,IBBDA)) Q:'IBBDA D
. ;WCJ;IB665;end
. S IBDTX=IBDT\1
. S IBDA=0 F S IBDA=$O(^IBA(364,"C",IBBDA,IBDA)) Q:'IBDA D
.. D STORE(IBDA,IBBDA,IBDTX,$P($G(^IBA(364,IBDA,0)),U,7)+1)
.. Q
. Q
;
; evaluate the test transmissions from file 361.4 (SRS 3.2.10.3)
;WCJ;IB665;start;added times to date/times in IBCEPTC
;S IBDT=IBDT1-.1
S IBDT=$$FMADD^XLFDT(IBDT1,,,,-1)
;WCJ;IB665;end
F S IBDT=$O(^IBM(361.4,"ALT",IBDT)) Q:'IBDT!(IBDT>IBDT2) S IBIFN=0 F S IBIFN=$O(^IBM(361.4,"ALT",IBDT,IBIFN)) Q:'IBIFN S IBZ1=0 F S IBZ1=$O(^IBM(361.4,IBIFN,1,IBZ1)) Q:'IBZ1 D
. S DATA=$G(^IBM(361.4,IBIFN,1,IBZ1,0)) Q:DATA=""
. ;WCJ;IB665;start;
. ;S IBDTX=$P(DATA,U,1)\1 ; transmit date
. S IBDTX=$P(DATA,U,1) ; transmit date
. ;WCJ;IB665;end
. Q:IBDTX<IBDT1 ; too early
. Q:IBDTX>IBDT2 ; too late
. S IBBDA=+$P(DATA,U,2) ; batch ien
. Q:'IBBDA
. ;
. ; attempt to find the corresponding entry in file 364 for this one
. S IB364="",CURSEQ=$TR(+$P(DATA,U,4),"123","PST")
. S IBZ=" " F S IBZ=$O(^IBA(364,"B",IBIFN,IBZ),-1) Q:'IBZ D Q:IB364
.. S IBZDAT=$G(^IBA(364,IBZ,0))
.. I $P(IBZDAT,U,8)'=CURSEQ Q ; no match on payer sequence
.. I $F(".X.P.","."_$P(IBZDAT,U,3)_".") Q ; transmission status must be farther than this
.. S IB364=IBZ Q
.. Q
. ;
. I 'IB364 Q ; need to have an entry in file 364 to proceed
. ;
. D STORE(IB364,IBBDA,IBDTX,3)
. Q
;
I IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2) G END ; Output report
;
D EN^VALM("IBCE VIEW PREV TRANS"_IBSORT) ; List Manager
;
END K ^TMP("IB_PREV_CLAIM",$J),^TMP("IB_PREV_CLAIM_INS",$J)
Q
;
LOC ; new sub-routine for locally printed claims (use LIST & STORE tags as a guide)
; Use the existing AP x-ref to narrow down the list of claims by date, then checks for existence in file 364 (EDI TRANSMIT BILL).
; If a claim is NOT in file 364, it is a printed-only claim
; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
; IBCRIT,IBPTCCAN,IBRCBFPC
; ^TMP("IB_PREV_CLAIM_INS,$J) global
K ^TMP("IB_PREV_CLAIM",$J)
N IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
N INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
I IBREP="R" N IBPAGE,IBSTOP,IBHDRDT S (IBPAGE,IBSTOP)=0
S IBDT=IBDT1-.1
F S IBDT=$O(^DGCR(399,"AP",IBDT)) Q:'IBDT!(IBDT>IBDT2) S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AP",IBDT,IBIFN)) Q:'IBIFN D
.; if it's in the transmit file it is not a printed claim
.Q:$D(^IBA(364,"B",IBIFN))
.S IB0=$G(^DGCR(399,IBIFN,0))
.S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
.;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
.I IBFORM'="A",$S(IBFT=3:IBFORM='"U",IBFT=2:IBFORM'="C",IBFT=7:IBFORM'="J",1:1) Q
.S IBCURI=$$CURR^IBCEF2(IBIFN) I 'IBCURI Q ; current ins ien
.S EDI=$$UP^XLFSTR($G(^DIC(36,IBCURI,3))) ; 3 node EDI data
.; do not include claims where the ins.co. still cannot transmit electronically
.Q:+$P(EDI,U)=0
.S PROF=$P(EDI,U,2),INST=$P(EDI,U,4) ; payer IDs
.;
.; screen for user selected insurance companies/payers
.I +$G(^TMP("IB_PREV_CLAIM_INS",$J)) D I 'INCLUDE Q
..S INCLUDE=0
..I $D(^TMP("IB_PREV_CLAIM_INS",$J,1,IBCURI)) S INCLUDE=1 Q
..I '$D(^TMP("IB_PREV_CLAIM_INS",$J,2)) Q
..I PROF'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,PROF)) S INCLUDE=1 Q
..I INST'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,INST)) S INCLUDE=1 Q
..Q
.;
.I IBCRIT=1,'$$MRASEC^IBCEF4(IBIFN) Q
.I IBCRIT=2,($$COBN^IBCEF(IBIFN)>1) Q
.I IBCRIT=3,($$COBN^IBCEF(IBIFN)=1) Q
.I IBCRIT=4,'$P($G(^DGCR(399,IBIFN,"TX")),U,7) Q
.;
.; skip cancelled claims conditionally
.I $P(IB0,U,13)=7,'IBPTCCAN Q
.;
.S IBS1=$P($G(^DIC(36,+IBCURI,0)),U)_U_+IBCURI,IBS2=IBDT
.;
.; Meets all selection criteria - extract to sort global
.S:IBS1="" IBS1=" " S:IBS2="" IBS2=" "
.I '$D(^TMP("IB_PREV_CLAIM",$J,IBS1)) S ^TMP("IB_PREV_CLAIM",$J,IBS1)=IBIFN
.S ^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBIFN)=3 ; 3 = test transmission
;
I IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2) G END ; Output report
;
D EN^VALM("IBCE VIEW LOC PRINT") ; List Manager, new one for sort =2
;
D END
Q
;
STORE(IB364,IBBDA,IBDTX,IBTYP) ; Check and store transmission data
; Parameters
; IB364 - ien to file 364 (claim transmission ien)
; IBBDA - ien to file 364.1 (batch ien)
; IBDTX - fm transmit date (no time) (either from 364.1 or 361.41)
; IBTYP - 1 = transmission data from file 364 (field .07 is live)
; 2 = transmission data from file 364 (field .07 is test)
; 3 = transmission data from file 361.41 (test always)
; Note:
; Variables IBFORM, IBCRIT, IBPTCCAN, IBRCBFPC, and IBSORT are
; assumed to exist here in this procedure.
;
NEW IBIFN,IB0,IBFT,IBCURI,INCLUDE,EDI,PROF,INST,IBBDA0,IBS1,IBS2
;
S IBIFN=+$G(^IBA(364,IB364,0))
S IB0=$G(^DGCR(399,IBIFN,0))
S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
I IBFORM'="A",$S(IBFT=3:IBFORM'="U",IBFT=2:IBFORM'="C",IBFT=7:IBFORM'="J",1:1) G STOREX
S IBCURI=$$CURR^IBCEF2(IBIFN) I 'IBCURI G STOREX ; current ins ien
S EDI=$$UP^XLFSTR($G(^DIC(36,IBCURI,3))) ; 3 node EDI data
S PROF=$P(EDI,U,2),INST=$P(EDI,U,4) ; payer IDs
;
; screen for user selected insurance companies/payers
I +$G(^TMP("IB_PREV_CLAIM_INS",$J)) D I 'INCLUDE G STOREX
. S INCLUDE=0
. I $D(^TMP("IB_PREV_CLAIM_INS",$J,1,IBCURI)) S INCLUDE=1 Q
. I '$D(^TMP("IB_PREV_CLAIM_INS",$J,2)) Q
. I PROF'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,PROF)) S INCLUDE=1 Q
. I INST'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,INST)) S INCLUDE=1 Q
. Q
;
I IBCRIT=1,'$$MRASEC^IBCEF4(IBIFN) G STOREX
I IBCRIT=2,($$COBN^IBCEF(IBIFN)>1) G STOREX
I IBCRIT=3,($$COBN^IBCEF(IBIFN)=1) G STOREX
I IBCRIT=4,'$P($G(^DGCR(399,IBIFN,"TX")),U,7) G STOREX
;WCJ;IB665;start
I IBCRIT=5,$$GET1^DIQ(364,IB364_",",.03,"I")'="A0" G STOREX
;WCJ;IB665;end
;
; skip cancelled claims conditionally
I $P(IB0,U,13)=7,'IBPTCCAN G STOREX
;
; skip claims forced to print at clearinghouse (claim check)
I $P($G(^DGCR(399,IBIFN,"TX")),U,8)=2,'IBRCBFPC G STOREX
;
; skip claims forced to print at clearinghouse (payer check)
I IBFT=2,PROF["PRNT",'IBRCBFPC G STOREX ; 1500, prof payer ID
I IBFT=3,INST["PRNT",'IBRCBFPC G STOREX ; ub, inst payer ID
;
S IBBDA0=$G(^IBA(364.1,+IBBDA,0)) ; 0 node of batch
;
S IBS1=$S(IBSORT=1:(99999999-IBDTX)_U_$P(IBBDA0,U)_U_$P(IBBDA0,U,14)_U_+$P(IBBDA0,U,5),1:$P($G(^DIC(36,+IBCURI,0)),U)_U_+IBCURI)
S IBS2=$S(IBSORT=1:$P(IB0,U,1),1:99999999-IBDTX)
;
; Meets all selection criteria - extract to sort global
S:IBS1="" IBS1=" " S:IBS2="" IBS2=" "
I '$D(^TMP("IB_PREV_CLAIM",$J,IBS1)) S ^TMP("IB_PREV_CLAIM",$J,IBS1)=$S(IBSORT=1:$$FMTE^XLFDT(IBDTX,"1"),1:IBIFN)
S ^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IB364)=IBTYP
;
STOREX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPTC0 8002 printed Apr 09, 2024@21:18:02 Page 2
IBCEPTC0 ;ALB/ESG - EDI PREVIOUSLY TRANSMITTED CLAIMS CONT ; 12/19/05
+1 ;;2.0;INTEGRATED BILLING;**320,348,547,592,665**;21-MAR-94;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
LIST ; Queued report format entrypoint
+1 ; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
+2 ; IBCRIT,IBPTCCAN,IBRCBFPC
+3 ; ^TMP("IB_PREV_CLAIM_INS,$J) global
+4 KILL ^TMP("IB_PREV_CLAIM",$JOB)
+5 NEW IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
+6 NEW INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
+7 IF IBREP="R"
NEW IBPAGE,IBSTOP,IBHDRDT
SET (IBPAGE,IBSTOP)=0
+8 ;
+9 ; evaluate claim transmission data from files 364.1 and 364
+10 ;WCJ;IB665;start;added times to date/times in IBCEPTC
+11 ;S IBDT=IBDT1-.1
+12 SET IBDT=$$FMADD^XLFDT(IBDT1,,,,-1)
+13 IF '+$PIECE(IBDT2,".",2)
SET IBDT2=$$FMADD^XLFDT(IBDT2,1,,,-1)
+14 ;F S IBDT=$O(^IBA(364.1,"ALT",IBDT)) Q:'IBDT!((IBDT\1)>IBDT2) S IBBDA=0 F S IBBDA=$O(^IBA(364.1,"ALT",IBDT,IBBDA)) Q:'IBBDA D
+15 FOR
SET IBDT=$ORDER(^IBA(364.1,"ALT",IBDT))
if 'IBDT!((IBDT)>IBDT2)
QUIT
SET IBBDA=0
FOR
SET IBBDA=$ORDER(^IBA(364.1,"ALT",IBDT,IBBDA))
if 'IBBDA
QUIT
Begin DoDot:1
+16 ;WCJ;IB665;end
+17 SET IBDTX=IBDT\1
+18 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBA(364,"C",IBBDA,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+19 DO STORE(IBDA,IBBDA,IBDTX,$PIECE($GET(^IBA(364,IBDA,0)),U,7)+1)
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 ;
+23 ; evaluate the test transmissions from file 361.4 (SRS 3.2.10.3)
+24 ;WCJ;IB665;start;added times to date/times in IBCEPTC
+25 ;S IBDT=IBDT1-.1
+26 SET IBDT=$$FMADD^XLFDT(IBDT1,,,,-1)
+27 ;WCJ;IB665;end
+28 FOR
SET IBDT=$ORDER(^IBM(361.4,"ALT",IBDT))
if 'IBDT!(IBDT>IBDT2)
QUIT
SET IBIFN=0
FOR
SET IBIFN=$ORDER(^IBM(361.4,"ALT",IBDT,IBIFN))
if 'IBIFN
QUIT
SET IBZ1=0
FOR
SET IBZ1=$ORDER(^IBM(361.4,IBIFN,1,IBZ1))
if 'IBZ1
QUIT
Begin DoDot:1
+29 SET DATA=$GET(^IBM(361.4,IBIFN,1,IBZ1,0))
if DATA=""
QUIT
+30 ;WCJ;IB665;start;
+31 ;S IBDTX=$P(DATA,U,1)\1 ; transmit date
+32 ; transmit date
SET IBDTX=$PIECE(DATA,U,1)
+33 ;WCJ;IB665;end
+34 ; too early
if IBDTX<IBDT1
QUIT
+35 ; too late
if IBDTX>IBDT2
QUIT
+36 ; batch ien
SET IBBDA=+$PIECE(DATA,U,2)
+37 if 'IBBDA
QUIT
+38 ;
+39 ; attempt to find the corresponding entry in file 364 for this one
+40 SET IB364=""
SET CURSEQ=$TRANSLATE(+$PIECE(DATA,U,4),"123","PST")
+41 SET IBZ=" "
FOR
SET IBZ=$ORDER(^IBA(364,"B",IBIFN,IBZ),-1)
if 'IBZ
QUIT
Begin DoDot:2
+42 SET IBZDAT=$GET(^IBA(364,IBZ,0))
+43 ; no match on payer sequence
IF $PIECE(IBZDAT,U,8)'=CURSEQ
QUIT
+44 ; transmission status must be farther than this
IF $FIND(".X.P.","."_$PIECE(IBZDAT,U,3)_".")
QUIT
+45 SET IB364=IBZ
QUIT
+46 QUIT
End DoDot:2
if IB364
QUIT
+47 ;
+48 ; need to have an entry in file 364 to proceed
IF 'IB364
QUIT
+49 ;
+50 DO STORE(IB364,IBBDA,IBDTX,3)
+51 QUIT
End DoDot:1
+52 ;
+53 ; Output report
IF IBREP="R"
DO RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2)
GOTO END
+54 ;
+55 ; List Manager
DO EN^VALM("IBCE VIEW PREV TRANS"_IBSORT)
+56 ;
END KILL ^TMP("IB_PREV_CLAIM",$JOB),^TMP("IB_PREV_CLAIM_INS",$JOB)
+1 QUIT
+2 ;
LOC ; new sub-routine for locally printed claims (use LIST & STORE tags as a guide)
+1 ; Use the existing AP x-ref to narrow down the list of claims by date, then checks for existence in file 364 (EDI TRANSMIT BILL).
+2 ; If a claim is NOT in file 364, it is a printed-only claim
+3 ; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
+4 ; IBCRIT,IBPTCCAN,IBRCBFPC
+5 ; ^TMP("IB_PREV_CLAIM_INS,$J) global
+6 KILL ^TMP("IB_PREV_CLAIM",$JOB)
+7 NEW IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
+8 NEW INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
+9 IF IBREP="R"
NEW IBPAGE,IBSTOP,IBHDRDT
SET (IBPAGE,IBSTOP)=0
+10 SET IBDT=IBDT1-.1
+11 FOR
SET IBDT=$ORDER(^DGCR(399,"AP",IBDT))
if 'IBDT!(IBDT>IBDT2)
QUIT
SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,"AP",IBDT,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+12 ; if it's in the transmit file it is not a printed claim
+13 if $DATA(^IBA(364,"B",IBIFN))
QUIT
+14 SET IB0=$GET(^DGCR(399,IBIFN,0))
+15 ; form type of claim
SET IBFT=$$FT^IBCEF(IBIFN)
+16 ;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
+17 IF IBFORM'="A"
IF $SELECT(IBFT=3:IBFORM='"U",IBFT=2:IBFORM'="C",IBFT=7:IBFORM'="J",1:1)
QUIT
+18 ; current ins ien
SET IBCURI=$$CURR^IBCEF2(IBIFN)
IF 'IBCURI
QUIT
+19 ; 3 node EDI data
SET EDI=$$UP^XLFSTR($GET(^DIC(36,IBCURI,3)))
+20 ; do not include claims where the ins.co. still cannot transmit electronically
+21 if +$PIECE(EDI,U)=0
QUIT
+22 ; payer IDs
SET PROF=$PIECE(EDI,U,2)
SET INST=$PIECE(EDI,U,4)
+23 ;
+24 ; screen for user selected insurance companies/payers
+25 IF +$GET(^TMP("IB_PREV_CLAIM_INS",$JOB))
Begin DoDot:2
+26 SET INCLUDE=0
+27 IF $DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,1,IBCURI))
SET INCLUDE=1
QUIT
+28 IF '$DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,2))
QUIT
+29 IF PROF'=""
IF $DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,2,PROF))
SET INCLUDE=1
QUIT
+30 IF INST'=""
IF $DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,2,INST))
SET INCLUDE=1
QUIT
+31 QUIT
End DoDot:2
IF 'INCLUDE
QUIT
+32 ;
+33 IF IBCRIT=1
IF '$$MRASEC^IBCEF4(IBIFN)
QUIT
+34 IF IBCRIT=2
IF ($$COBN^IBCEF(IBIFN)>1)
QUIT
+35 IF IBCRIT=3
IF ($$COBN^IBCEF(IBIFN)=1)
QUIT
+36 IF IBCRIT=4
IF '$PIECE($GET(^DGCR(399,IBIFN,"TX")),U,7)
QUIT
+37 ;
+38 ; skip cancelled claims conditionally
+39 IF $PIECE(IB0,U,13)=7
IF 'IBPTCCAN
QUIT
+40 ;
+41 SET IBS1=$PIECE($GET(^DIC(36,+IBCURI,0)),U)_U_+IBCURI
SET IBS2=IBDT
+42 ;
+43 ; Meets all selection criteria - extract to sort global
+44 if IBS1=""
SET IBS1=" "
if IBS2=""
SET IBS2=" "
+45 IF '$DATA(^TMP("IB_PREV_CLAIM",$JOB,IBS1))
SET ^TMP("IB_PREV_CLAIM",$JOB,IBS1)=IBIFN
+46 ; 3 = test transmission
SET ^TMP("IB_PREV_CLAIM",$JOB,IBS1,IBS2,IBIFN)=3
End DoDot:1
+47 ;
+48 ; Output report
IF IBREP="R"
DO RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2)
GOTO END
+49 ;
+50 ; List Manager, new one for sort =2
DO EN^VALM("IBCE VIEW LOC PRINT")
+51 ;
+52 DO END
+53 QUIT
+54 ;
STORE(IB364,IBBDA,IBDTX,IBTYP) ; Check and store transmission data
+1 ; Parameters
+2 ; IB364 - ien to file 364 (claim transmission ien)
+3 ; IBBDA - ien to file 364.1 (batch ien)
+4 ; IBDTX - fm transmit date (no time) (either from 364.1 or 361.41)
+5 ; IBTYP - 1 = transmission data from file 364 (field .07 is live)
+6 ; 2 = transmission data from file 364 (field .07 is test)
+7 ; 3 = transmission data from file 361.41 (test always)
+8 ; Note:
+9 ; Variables IBFORM, IBCRIT, IBPTCCAN, IBRCBFPC, and IBSORT are
+10 ; assumed to exist here in this procedure.
+11 ;
+12 NEW IBIFN,IB0,IBFT,IBCURI,INCLUDE,EDI,PROF,INST,IBBDA0,IBS1,IBS2
+13 ;
+14 SET IBIFN=+$GET(^IBA(364,IB364,0))
+15 SET IB0=$GET(^DGCR(399,IBIFN,0))
+16 ; form type of claim
SET IBFT=$$FT^IBCEF(IBIFN)
+17 ;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
+18 IF IBFORM'="A"
IF $SELECT(IBFT=3:IBFORM'="U",IBFT=2:IBFORM'="C",IBFT=7:IBFORM'="J",1:1)
GOTO STOREX
+19 ; current ins ien
SET IBCURI=$$CURR^IBCEF2(IBIFN)
IF 'IBCURI
GOTO STOREX
+20 ; 3 node EDI data
SET EDI=$$UP^XLFSTR($GET(^DIC(36,IBCURI,3)))
+21 ; payer IDs
SET PROF=$PIECE(EDI,U,2)
SET INST=$PIECE(EDI,U,4)
+22 ;
+23 ; screen for user selected insurance companies/payers
+24 IF +$GET(^TMP("IB_PREV_CLAIM_INS",$JOB))
Begin DoDot:1
+25 SET INCLUDE=0
+26 IF $DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,1,IBCURI))
SET INCLUDE=1
QUIT
+27 IF '$DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,2))
QUIT
+28 IF PROF'=""
IF $DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,2,PROF))
SET INCLUDE=1
QUIT
+29 IF INST'=""
IF $DATA(^TMP("IB_PREV_CLAIM_INS",$JOB,2,INST))
SET INCLUDE=1
QUIT
+30 QUIT
End DoDot:1
IF 'INCLUDE
GOTO STOREX
+31 ;
+32 IF IBCRIT=1
IF '$$MRASEC^IBCEF4(IBIFN)
GOTO STOREX
+33 IF IBCRIT=2
IF ($$COBN^IBCEF(IBIFN)>1)
GOTO STOREX
+34 IF IBCRIT=3
IF ($$COBN^IBCEF(IBIFN)=1)
GOTO STOREX
+35 IF IBCRIT=4
IF '$PIECE($GET(^DGCR(399,IBIFN,"TX")),U,7)
GOTO STOREX
+36 ;WCJ;IB665;start
+37 IF IBCRIT=5
IF $$GET1^DIQ(364,IB364_",",.03,"I")'="A0"
GOTO STOREX
+38 ;WCJ;IB665;end
+39 ;
+40 ; skip cancelled claims conditionally
+41 IF $PIECE(IB0,U,13)=7
IF 'IBPTCCAN
GOTO STOREX
+42 ;
+43 ; skip claims forced to print at clearinghouse (claim check)
+44 IF $PIECE($GET(^DGCR(399,IBIFN,"TX")),U,8)=2
IF 'IBRCBFPC
GOTO STOREX
+45 ;
+46 ; skip claims forced to print at clearinghouse (payer check)
+47 ; 1500, prof payer ID
IF IBFT=2
IF PROF["PRNT"
IF 'IBRCBFPC
GOTO STOREX
+48 ; ub, inst payer ID
IF IBFT=3
IF INST["PRNT"
IF 'IBRCBFPC
GOTO STOREX
+49 ;
+50 ; 0 node of batch
SET IBBDA0=$GET(^IBA(364.1,+IBBDA,0))
+51 ;
+52 SET IBS1=$SELECT(IBSORT=1:(99999999-IBDTX)_U_$PIECE(IBBDA0,U)_U_$PIECE(IBBDA0,U,14)_U_+$PIECE(IBBDA0,U,5),1:$PIECE($GET(^DIC(36,+IBCURI,0)),U)_U_+IBCURI)
+53 SET IBS2=$SELECT(IBSORT=1:$PIECE(IB0,U,1),1:99999999-IBDTX)
+54 ;
+55 ; Meets all selection criteria - extract to sort global
+56 if IBS1=""
SET IBS1=" "
if IBS2=""
SET IBS2=" "
+57 IF '$DATA(^TMP("IB_PREV_CLAIM",$JOB,IBS1))
SET ^TMP("IB_PREV_CLAIM",$JOB,IBS1)=$SELECT(IBSORT=1:$$FMTE^XLFDT(IBDTX,"1"),1:IBIFN)
+58 SET ^TMP("IB_PREV_CLAIM",$JOB,IBS1,IBS2,IB364)=IBTYP
+59 ;
STOREX ;
+1 QUIT
+2 ;
