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

IBCEPTC0.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. LIST ; Queued report format entrypoint
  1. ; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
  1. ; IBCRIT,IBPTCCAN,IBRCBFPC
  1. ; ^TMP("IB_PREV_CLAIM_INS,$J) global
  1. K ^TMP("IB_PREV_CLAIM",$J)
  1. N IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
  1. N INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
  1. I IBREP="R" N IBPAGE,IBSTOP,IBHDRDT S (IBPAGE,IBSTOP)=0
  1. ;
  1. ; evaluate claim transmission data from files 364.1 and 364
  1. ;WCJ;IB665;start;added times to date/times in IBCEPTC
  1. ;S IBDT=IBDT1-.1
  1. S IBDT=$$FMADD^XLFDT(IBDT1,,,,-1)
  1. I '+$P(IBDT2,".",2) S IBDT2=$$FMADD^XLFDT(IBDT2,1,,,-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
  1. 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
  1. . ;WCJ;IB665;end
  1. . S IBDTX=IBDT\1
  1. . S IBDA=0 F S IBDA=$O(^IBA(364,"C",IBBDA,IBDA)) Q:'IBDA D
  1. .. D STORE(IBDA,IBBDA,IBDTX,$P($G(^IBA(364,IBDA,0)),U,7)+1)
  1. .. Q
  1. . Q
  1. ;
  1. ; evaluate the test transmissions from file 361.4 (SRS 3.2.10.3)
  1. ;WCJ;IB665;start;added times to date/times in IBCEPTC
  1. ;S IBDT=IBDT1-.1
  1. S IBDT=$$FMADD^XLFDT(IBDT1,,,,-1)
  1. ;WCJ;IB665;end
  1. 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
  1. . S DATA=$G(^IBM(361.4,IBIFN,1,IBZ1,0)) Q:DATA=""
  1. . ;WCJ;IB665;start;
  1. . ;S IBDTX=$P(DATA,U,1)\1 ; transmit date
  1. . S IBDTX=$P(DATA,U,1) ; transmit date
  1. . ;WCJ;IB665;end
  1. . Q:IBDTX<IBDT1 ; too early
  1. . Q:IBDTX>IBDT2 ; too late
  1. . S IBBDA=+$P(DATA,U,2) ; batch ien
  1. . Q:'IBBDA
  1. . ;
  1. . ; attempt to find the corresponding entry in file 364 for this one
  1. . S IB364="",CURSEQ=$TR(+$P(DATA,U,4),"123","PST")
  1. . S IBZ=" " F S IBZ=$O(^IBA(364,"B",IBIFN,IBZ),-1) Q:'IBZ D Q:IB364
  1. .. S IBZDAT=$G(^IBA(364,IBZ,0))
  1. .. I $P(IBZDAT,U,8)'=CURSEQ Q ; no match on payer sequence
  1. .. I $F(".X.P.","."_$P(IBZDAT,U,3)_".") Q ; transmission status must be farther than this
  1. .. S IB364=IBZ Q
  1. .. Q
  1. . ;
  1. . I 'IB364 Q ; need to have an entry in file 364 to proceed
  1. . ;
  1. . D STORE(IB364,IBBDA,IBDTX,3)
  1. . Q
  1. ;
  1. I IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2) G END ; Output report
  1. ;
  1. D EN^VALM("IBCE VIEW PREV TRANS"_IBSORT) ; List Manager
  1. ;
  1. END K ^TMP("IB_PREV_CLAIM",$J),^TMP("IB_PREV_CLAIM_INS",$J)
  1. Q
  1. ;
  1. 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).
  1. ; If a claim is NOT in file 364, it is a printed-only claim
  1. ; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
  1. ; IBCRIT,IBPTCCAN,IBRCBFPC
  1. ; ^TMP("IB_PREV_CLAIM_INS,$J) global
  1. K ^TMP("IB_PREV_CLAIM",$J)
  1. N IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
  1. N INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
  1. I IBREP="R" N IBPAGE,IBSTOP,IBHDRDT S (IBPAGE,IBSTOP)=0
  1. S IBDT=IBDT1-.1
  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
  1. .; if it's in the transmit file it is not a printed claim
  1. .Q:$D(^IBA(364,"B",IBIFN))
  1. .S IB0=$G(^DGCR(399,IBIFN,0))
  1. .S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
  1. .;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
  1. .I IBFORM'="A",$S(IBFT=3:IBFORM='"U",IBFT=2:IBFORM'="C",IBFT=7:IBFORM'="J",1:1) Q
  1. .S IBCURI=$$CURR^IBCEF2(IBIFN) I 'IBCURI Q ; current ins ien
  1. .S EDI=$$UP^XLFSTR($G(^DIC(36,IBCURI,3))) ; 3 node EDI data
  1. .; do not include claims where the ins.co. still cannot transmit electronically
  1. .Q:+$P(EDI,U)=0
  1. .S PROF=$P(EDI,U,2),INST=$P(EDI,U,4) ; payer IDs
  1. .;
  1. .; screen for user selected insurance companies/payers
  1. .I +$G(^TMP("IB_PREV_CLAIM_INS",$J)) D I 'INCLUDE Q
  1. ..S INCLUDE=0
  1. ..I $D(^TMP("IB_PREV_CLAIM_INS",$J,1,IBCURI)) S INCLUDE=1 Q
  1. ..I '$D(^TMP("IB_PREV_CLAIM_INS",$J,2)) Q
  1. ..I PROF'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,PROF)) S INCLUDE=1 Q
  1. ..I INST'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,INST)) S INCLUDE=1 Q
  1. ..Q
  1. .;
  1. .I IBCRIT=1,'$$MRASEC^IBCEF4(IBIFN) Q
  1. .I IBCRIT=2,($$COBN^IBCEF(IBIFN)>1) Q
  1. .I IBCRIT=3,($$COBN^IBCEF(IBIFN)=1) Q
  1. .I IBCRIT=4,'$P($G(^DGCR(399,IBIFN,"TX")),U,7) Q
  1. .;
  1. .; skip cancelled claims conditionally
  1. .I $P(IB0,U,13)=7,'IBPTCCAN Q
  1. .;
  1. .S IBS1=$P($G(^DIC(36,+IBCURI,0)),U)_U_+IBCURI,IBS2=IBDT
  1. .;
  1. .; Meets all selection criteria - extract to sort global
  1. .S:IBS1="" IBS1=" " S:IBS2="" IBS2=" "
  1. .I '$D(^TMP("IB_PREV_CLAIM",$J,IBS1)) S ^TMP("IB_PREV_CLAIM",$J,IBS1)=IBIFN
  1. .S ^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBIFN)=3 ; 3 = test transmission
  1. ;
  1. I IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2) G END ; Output report
  1. ;
  1. D EN^VALM("IBCE VIEW LOC PRINT") ; List Manager, new one for sort =2
  1. ;
  1. D END
  1. Q
  1. ;
  1. STORE(IB364,IBBDA,IBDTX,IBTYP) ; Check and store transmission data
  1. ; Parameters
  1. ; IB364 - ien to file 364 (claim transmission ien)
  1. ; IBBDA - ien to file 364.1 (batch ien)
  1. ; IBDTX - fm transmit date (no time) (either from 364.1 or 361.41)
  1. ; IBTYP - 1 = transmission data from file 364 (field .07 is live)
  1. ; 2 = transmission data from file 364 (field .07 is test)
  1. ; 3 = transmission data from file 361.41 (test always)
  1. ; Note:
  1. ; Variables IBFORM, IBCRIT, IBPTCCAN, IBRCBFPC, and IBSORT are
  1. ; assumed to exist here in this procedure.
  1. ;
  1. NEW IBIFN,IB0,IBFT,IBCURI,INCLUDE,EDI,PROF,INST,IBBDA0,IBS1,IBS2
  1. ;
  1. S IBIFN=+$G(^IBA(364,IB364,0))
  1. S IB0=$G(^DGCR(399,IBIFN,0))
  1. S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
  1. ;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
  1. I IBFORM'="A",$S(IBFT=3:IBFORM'="U",IBFT=2:IBFORM'="C",IBFT=7:IBFORM'="J",1:1) G STOREX
  1. S IBCURI=$$CURR^IBCEF2(IBIFN) I 'IBCURI G STOREX ; current ins ien
  1. S EDI=$$UP^XLFSTR($G(^DIC(36,IBCURI,3))) ; 3 node EDI data
  1. S PROF=$P(EDI,U,2),INST=$P(EDI,U,4) ; payer IDs
  1. ;
  1. ; screen for user selected insurance companies/payers
  1. I +$G(^TMP("IB_PREV_CLAIM_INS",$J)) D I 'INCLUDE G STOREX
  1. . S INCLUDE=0
  1. . I $D(^TMP("IB_PREV_CLAIM_INS",$J,1,IBCURI)) S INCLUDE=1 Q
  1. . I '$D(^TMP("IB_PREV_CLAIM_INS",$J,2)) Q
  1. . I PROF'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,PROF)) S INCLUDE=1 Q
  1. . I INST'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,INST)) S INCLUDE=1 Q
  1. . Q
  1. ;
  1. I IBCRIT=1,'$$MRASEC^IBCEF4(IBIFN) G STOREX
  1. I IBCRIT=2,($$COBN^IBCEF(IBIFN)>1) G STOREX
  1. I IBCRIT=3,($$COBN^IBCEF(IBIFN)=1) G STOREX
  1. I IBCRIT=4,'$P($G(^DGCR(399,IBIFN,"TX")),U,7) G STOREX
  1. ;WCJ;IB665;start
  1. I IBCRIT=5,$$GET1^DIQ(364,IB364_",",.03,"I")'="A0" G STOREX
  1. ;WCJ;IB665;end
  1. ;
  1. ; skip cancelled claims conditionally
  1. I $P(IB0,U,13)=7,'IBPTCCAN G STOREX
  1. ;
  1. ; skip claims forced to print at clearinghouse (claim check)
  1. I $P($G(^DGCR(399,IBIFN,"TX")),U,8)=2,'IBRCBFPC G STOREX
  1. ;
  1. ; skip claims forced to print at clearinghouse (payer check)
  1. I IBFT=2,PROF["PRNT",'IBRCBFPC G STOREX ; 1500, prof payer ID
  1. I IBFT=3,INST["PRNT",'IBRCBFPC G STOREX ; ub, inst payer ID
  1. ;
  1. S IBBDA0=$G(^IBA(364.1,+IBBDA,0)) ; 0 node of batch
  1. ;
  1. 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)
  1. S IBS2=$S(IBSORT=1:$P(IB0,U,1),1:99999999-IBDTX)
  1. ;
  1. ; Meets all selection criteria - extract to sort global
  1. S:IBS1="" IBS1=" " S:IBS2="" IBS2=" "
  1. I '$D(^TMP("IB_PREV_CLAIM",$J,IBS1)) S ^TMP("IB_PREV_CLAIM",$J,IBS1)=$S(IBSORT=1:$$FMTE^XLFDT(IBDTX,"1"),1:IBIFN)
  1. S ^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IB364)=IBTYP
  1. ;
  1. STOREX ;
  1. Q
  1. ;