source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPTC0.m@ 686

Last change on this file since 686 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1IBCEPTC0 ;ALB/ESG - EDI PREVIOUSLY TRANSMITTED CLAIMS CONT ; 12/19/05
2 ;;2.0;INTEGRATED BILLING;**320,348**;21-MAR-94;Build 5
3 ;
4 Q
5 ;
6LIST ; Queued report format entrypoint
7 ; variables pre-defined: IBREP,IBSORT,IBFORM,IBDT1,IBDT2,
8 ; IBCRIT,IBPTCCAN,IBRCBFPC
9 ; ^TMP("IB_PREV_CLAIM_INS,$J) global
10 K ^TMP("IB_PREV_CLAIM",$J)
11 N IBBDA,IBBDA0,IBCURI,IBDA,IBDT,IBFT,IBIFN,IBS1,IBS2,IBDTX
12 N INCLUDE,EDI,PROF,INST,IB0,IBZ1,DATA,IB364,CURSEQ,IBZ,IBZDAT
13 I IBREP="R" N IBPAGE,IBSTOP,IBHDRDT S (IBPAGE,IBSTOP)=0
14 ;
15 ; evaluate claim transmission data from files 364.1 and 364
16 S IBDT=IBDT1-.1
17 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
18 . S IBDTX=IBDT\1
19 . S IBDA=0 F S IBDA=$O(^IBA(364,"C",IBBDA,IBDA)) Q:'IBDA D
20 .. D STORE(IBDA,IBBDA,IBDTX,$P($G(^IBA(364,IBDA,0)),U,7)+1)
21 .. Q
22 . Q
23 ;
24 ; evaluate the test transmissions from file 361.4 (SRS 3.2.10.3)
25 S IBDT=IBDT1-.1
26 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
27 . S DATA=$G(^IBM(361.4,IBIFN,1,IBZ1,0)) Q:DATA=""
28 . S IBDTX=$P(DATA,U,1)\1 ; transmit date
29 . Q:IBDTX<IBDT1 ; too early
30 . Q:IBDTX>IBDT2 ; too late
31 . S IBBDA=+$P(DATA,U,2) ; batch ien
32 . Q:'IBBDA
33 . ;
34 . ; attempt to find the corresponding entry in file 364 for this one
35 . S IB364="",CURSEQ=$TR(+$P(DATA,U,4),"123","PST")
36 . S IBZ=" " F S IBZ=$O(^IBA(364,"B",IBIFN,IBZ),-1) Q:'IBZ D Q:IB364
37 .. S IBZDAT=$G(^IBA(364,IBZ,0))
38 .. I $P(IBZDAT,U,8)'=CURSEQ Q ; no match on payer sequence
39 .. I $F(".X.P.","."_$P(IBZDAT,U,3)_".") Q ; transmission status must be farther than this
40 .. S IB364=IBZ Q
41 .. Q
42 . ;
43 . I 'IB364 Q ; need to have an entry in file 364 to proceed
44 . ;
45 . D STORE(IB364,IBBDA,IBDTX,3)
46 . Q
47 ;
48 I IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2) G END ; Output report
49 ;
50 D EN^VALM("IBCE VIEW PREV TRANS"_IBSORT) ; List Manager
51 ;
52END K ^TMP("IB_PREV_CLAIM",$J),^TMP("IB_PREV_CLAIM_INS",$J)
53 Q
54 ;
55STORE(IB364,IBBDA,IBDTX,IBTYP) ; Check and store transmission data
56 ; Parameters
57 ; IB364 - ien to file 364 (claim transmission ien)
58 ; IBBDA - ien to file 364.1 (batch ien)
59 ; IBDTX - fm transmit date (no time) (either from 364.1 or 361.41)
60 ; IBTYP - 1 = transmission data from file 364 (field .07 is live)
61 ; 2 = transmission data from file 364 (field .07 is test)
62 ; 3 = transmission data from file 361.41 (test always)
63 ; Note:
64 ; Variables IBFORM, IBCRIT, IBPTCCAN, IBRCBFPC, and IBSORT are
65 ; assumed to exist here in this procedure.
66 ;
67 NEW IBIFN,IB0,IBFT,IBCURI,INCLUDE,EDI,PROF,INST,IBBDA0,IBS1,IBS2
68 ;
69 S IBIFN=+$G(^IBA(364,IB364,0))
70 S IB0=$G(^DGCR(399,IBIFN,0))
71 S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
72 I IBFORM'="B",$S(IBFT=3:IBFORM="C",IBFT=2:IBFORM="U",1:1) G STOREX
73 S IBCURI=$$CURR^IBCEF2(IBIFN) I 'IBCURI G STOREX ; current ins ien
74 S EDI=$$UP^XLFSTR($G(^DIC(36,IBCURI,3))) ; 3 node EDI data
75 S PROF=$P(EDI,U,2),INST=$P(EDI,U,4) ; payer IDs
76 ;
77 ; screen for user selected insurance companies/payers
78 I +$G(^TMP("IB_PREV_CLAIM_INS",$J)) D I 'INCLUDE G STOREX
79 . S INCLUDE=0
80 . I $D(^TMP("IB_PREV_CLAIM_INS",$J,1,IBCURI)) S INCLUDE=1 Q
81 . I '$D(^TMP("IB_PREV_CLAIM_INS",$J,2)) Q
82 . I PROF'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,PROF)) S INCLUDE=1 Q
83 . I INST'="",$D(^TMP("IB_PREV_CLAIM_INS",$J,2,INST)) S INCLUDE=1 Q
84 . Q
85 ;
86 I IBCRIT=1,'$$MRASEC^IBCEF4(IBIFN) G STOREX
87 I IBCRIT=2,($$COBN^IBCEF(IBIFN)>1) G STOREX
88 I IBCRIT=3,($$COBN^IBCEF(IBIFN)=1) G STOREX
89 I IBCRIT=4,'$P($G(^DGCR(399,IBIFN,"TX")),U,7) G STOREX
90 ;
91 ; skip cancelled claims conditionally
92 I $P(IB0,U,13)=7,'IBPTCCAN G STOREX
93 ;
94 ; skip claims forced to print at clearinghouse (claim check)
95 I $P($G(^DGCR(399,IBIFN,"TX")),U,8)=2,'IBRCBFPC G STOREX
96 ;
97 ; skip claims forced to print at clearinghouse (payer check)
98 I IBFT=2,PROF["PRNT",'IBRCBFPC G STOREX ; 1500, prof payer ID
99 I IBFT=3,INST["PRNT",'IBRCBFPC G STOREX ; ub, inst payer ID
100 ;
101 S IBBDA0=$G(^IBA(364.1,+IBBDA,0)) ; 0 node of batch
102 ;
103 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)
104 S IBS2=$S(IBSORT=1:$P(IB0,U,1),1:99999999-IBDTX)
105 ;
106 ; Meets all selection criteria - extract to sort global
107 S:IBS1="" IBS1=" " S:IBS2="" IBS2=" "
108 I '$D(^TMP("IB_PREV_CLAIM",$J,IBS1)) S ^TMP("IB_PREV_CLAIM",$J,IBS1)=$S(IBSORT=1:$$FMTE^XLFDT(IBDTX,"1"),1:IBIFN)
109 S ^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IB364)=IBTYP
110 ;
111STOREX ;
112 Q
113 ;
Note: See TracBrowser for help on using the repository browser.