- 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 Feb 18, 2025@23:38:26 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 ;