source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF4.m@ 1005

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

initial load of WorldVistAEHR
File size: 6.8 KB
RevLine 
[613]1IBCEF4 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES ;06-FEB-96
2 ;;2.0;INTEGRATED BILLING;**51,137,232,155,296,327,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EDIACTV(IBEDIMRA) ; Returns 0 if EDI or MRA is not active,
6 ; otherwise, returns 1
7 ; IBEDIMRA : 1= checking if EDI is active, 2= checking if MRA is active
8 N IBEDI
9 S IBEDI=$P($G(^IBE(350.9,1,8)),U,10)
10 Q $S('IBEDI:0,IBEDI=3:1,1:IBEDI=IBEDIMRA)
11 ;
12RATEOK(IBIFN) ; Returns 1 if rate type of bill IBIFN is transmittable
13 Q +$P($G(^DGCR(399.3,+$P($G(^DGCR(399,IBIFN,0)),U,7),0)),U,10)
14 ;
15INSOK(INS) ; Determine EDI activation status of insurance co
16 Q +$G(^DIC(36,INS,3)) ;1 = TEST, 2 = LIVE, 0 = NOT ACTIVE FOR EDI
17 ;
18BSTATX(IBIFN) ; Returns internal value of bill's latest transmission status
19 N IBDA
20 Q $P($G(^IBA(364,+$$LAST364(IBIFN),0)),U,3)
21 ;
22LAST364(IBIFN) ; Determine ien of latest transmit bill record for a bill
23 Q +$O(^IBA(364,"ABDT",IBIFN,+$O(^IBA(364,"ABDT",IBIFN,""),-1),""),-1)
24 ;
25TXMT(IBIFN,IBWHY,IBNEW) ; Determine if bill # IBIFN is 'transmittable'
26 ; IBNEW = flag is 1 if new entry - don't check for entry in file 364
27 ; Function returns:
28 ; 0 if not transmittable
29 ; if transmittable, the entire node 3 of the insurance company
30 ; and, if passed by reference IBWHY = reason not transmittable
31 ; 1 if local print
32 ; 2 if EDI/MRA not active
33 ; 3 if rate type not transmittable
34 ; 4 if no transmit for insurance co
35 ; 5 if failed txmn rules
36 ; and IBWHY(0) = ien of rule failed
37 ; 6 if Rx with missing/invalid NDC format
38 ;
39 N IB,IB0,IBOK,IBCOB,IBMCR,X1
40 S IBOK=1,IB=IBIFN,IBWHY=""
41 ;
42 S IBCOB=$$COBN^IBCEF(IB),IB(.07)=+$G(^DGCR(399,IB,"I"_IBCOB))
43 S IBMCR=$$MCRWNR^IBEFUNC(IB(.07))
44 ; Does bill have force local print flag set?
45 I 'IBMCR D G:IBWHY TXMTQ ; MCR WNR not curr ins
46 . I $S($$MRASEC(IBIFN):$P($G(^DGCR(399,IBIFN,"TX")),U,9)=1,1:$P($G(^DGCR(399,IBIFN,"TX")),U,8)=1) S IBOK=0,IBWHY=1
47 I '$G(IBNEW),'$O(^IBA(364,"B",IBIFN,0)),$P($G(^DGCR(399,IBIFN,0)),U,13)>2,'$$RETN^PRCAFN(IBIFN) S IBOK=0 G TXMTQ ; Not recognized as transmittable when it was authorized
48 I $O(^IBA(364,"B",IBIFN,0)),$$INSOK(IB(.07)),$$BSTATX(IBIFN)'="X" G TXMTQ ;Already determined to be transmittable - entry exists for bill in transmit bill file
49 S IB(.03)=$S('IBMCR:1,1:2) ; EDI(1) or MRA(2)
50 S IB(.04)=$S('$$INPAT^IBCEF(IB,1):1,1:2) ;Outpt(1) or Inpt(2)
51 S IB(.05)=$S($$FT^IBCEF(IB)=3:1,1:2) ;Inst(1) or Prof(2)
52 ; Execute unmodifiable, general edits
53 S X1=$$EDIACTV(IB(.03))
54 I 'X1 S IBWHY=2
55 I 'IBWHY S X1=$$RATEOK(IBIFN) S:'X1 IBWHY=3
56 I 'IBWHY S X1=$$INSOK(+IB(.07)) S:'X1 IBWHY=4
57 I 'IBWHY,$$ISRX^IBCEF1(IBIFN) D ;S:'X1 IBWHY=6
58 . ; Check for Rxs and NDC # format valid (5-4-2)
59 . ;IF THIS IS A UB FORM DO NOT SEND ELECTRONIC
60 . I $$FT^IBCEF(IBIFN)=3 S IBWHY=1
61 . ;
62 . Q ;;CHECK REMOVAL SO NON NDC FORMAT NUMBERS WILL GO
63 . N Z,Z0,Z00
64 . S Z="" F S Z=$O(^IBA(362.4,"AIFN"_IBIFN,Z)) Q:Z=""!'X1 D Q:'X1
65 .. S Z0=0 F S Z0=$O(^IBA(362.4,"AIFN"_IBIFN,Z,Z0)) Q:'Z0 D Q:'X1
66 ... S Z00=$G(^IBA(362.4,Z0,0))
67 ... Q:$S($P(Z00,U,8)="":1,1:$L($P(Z00,U,8))=11)
68 ... I $P(Z00,U,9)'=4 S X1=0
69 ; Only continue if general edits are passed
70 I $$COB^IBCEF(IB)="S" D
71 . S COBINS=$P($G(^DGCR(399,IB,"M")),U,IBCOB+1)
72 . I 'COBINS Q
73 . I IBMCR S IBWHY=1,$P(^DGCR(399,IBIFN,"TX"),U,8)=1
74 I IBWHY S IBOK=0 G TXMTQ
75 S IBOK=$$EDIT(IBIFN,.IB,.IBWHY)
76 G:'IBOK TXMTQ
77 ;
78TXMTQ ;
79 I IBOK S IBOK=$G(^DIC(36,+IB(.07),3))
80 Q IBOK
81 ;
82MRASEC(IBIFN) ; Returns 1 if current bill is secondary to MCR WNR
83 N IBSEQ,IB,Z
84 S IB=0
85 ; Chk if MCR WNR is prev insurer with MRA on file
86 S IBSEQ=$$COBN^IBCEF(IBIFN)-1
87 S Z=$$MCRONBIL^IBEFUNC(IBIFN,IBSEQ) I +Z=1,$P(Z,U,2)=1,$$CHK^IBCEMU1(IBIFN) S IB=1
88 Q IB
89 ;
90EDIT(IBIFN,IB,IBWHY) ; Find, execute edits applying to bill to see if transmittable
91 ; IBIFN = ien of bill in file 399
92 ; IB = array containing necessary data for xref search from bill
93 ; subscripted by field # in file 364.4
94 ;
95 ; Matrix entries:
96 ; IB(.03): 1=EDI specific, 2=MRA specific
97 ; IB(.04): 1=Outpatient or 2=inpatient only (currently defaults to 3)
98 ; IB(.05): 1=Only institutional or 2=only professional
99 ; X: Anything valid
100 ;
101 ; MRA-EDI IN-OUT INST-PROF
102 ; Level ------- ------ ---------
103 ; 1 X X X
104 ; 2 X X IB(.05)
105 ; 3 X IB(.04) X
106 ; 4 X IB(.04) IB(.05)
107 ; 5 IB(.03) X X
108 ; 6 IB(.03) X IB(.05)
109 ; 7 IB(.03) IB(.04) X
110 ; 8 IB(.03) IB(.04) IB(.05)
111 ;
112 N IB0,IB1,IB2,IB3,IB4,IBDA,IBFT,IBPASS,IBSEQ,IBT,IBNOCK
113 I '$G(IB(.03)) S IBPASS=0 G EDITQ
114 S IBFT=$$FT^IBCEF(IBIFN)
115 ;
116 S IBPASS=1
117 F IBSEQ=1:1:8 D Q:'IBPASS ; Loop thru levels in matrix
118 . F IB1=1:1:3 Q:'IBPASS F IB2=1:1:3 Q:'IBPASS F IB3=1:1:3 Q:'IBPASS D
119 .. S IB4=0 F S IB4=$O(^IBE(364.4,"AD",IB1,IB2,IB3,IB4)) Q:'IB4 I $O(^(IB4,0)) D Q:'IBPASS
120 ... S IBDA=0
121 ... F S IBDA=$O(^IBE(364.4,"AD",IB1,IB2,IB3,IB4,IBDA)) Q:'IBDA S IB0=$G(^IBE(364.4,IBDA,0)) I IB0'="",'$D(IBNOCK(IBDA)) D Q:'IBPASS
122 .... I $P(IB0,U,2)>DT S IBNOCK(IBDA)="" Q ; Not activated yet
123 .... I $P(IB0,U,6),$P(IB0,U,6)'>DT S IBNOCK(IBDA)="" Q ; Inactive
124 .... I $P(IB0,U,11),IB3'=3,$S(IBFT=3:IB3'=1,IBFT=2:IB3'=2,1:0) S IBNOCK(IBDA)="" Q ; Form type not included - not used for form type rule (0)
125 .... I IB4=1,'$D(^IBE(364.4,IBDA,3,"B",+IB(.07))) S IBNOCK(IBDA)="" Q ; Ins not included for rule
126 .... I IB4=2,$D(^IBE(364.4,IBDA,2,"B",+IB(.07))) S IBNOCK(IBDA)="" Q ; Ins is excluded from rule
127 .... S IBT=$G(^IBE(364.4,IBDA,1))
128 .... ; Code can assume IBIFN, IBDA and IB(.03 thru .05 and .07) exist
129 .... I IBT'="" X IBT I '$T S IBPASS=0,IBWHY(0)=IBDA,IBWHY=5
130EDITQ Q IBPASS
131 ;
132STATUS(IBIFN) ; Function returns whether or not bill currently has a status
133 ; message or EOB message not yet fully reviewed -
134 ; (only for transmittable bills)
135 ; IBIFN = ien of bill in file 399
136 ; Returns:
137 ; 0 = None found
138 ; If found, returns a pieced string as follows:
139 ;
140 ; [1] ien of transmit bill entry (file 364) associated with an
141 ; entry in file 361 with an unreviewed status message
142 ; [2] ien of transmit bill entry (file 364) associated with an
143 ; entry in file 361.1 with an unreviewed EOB
144 ;
145 N IB,Z,Z0
146 S IB=""
147 S Z="" F S Z=$O(^IBM(361,"B",IBIFN,Z),-1) Q:'Z I $P($G(^IBM(361,Z,0)),U,9)<2,$P(^(0),U,11) S $P(IB,U)=$P(^(0),U,11) Q
148 ;
149 S Z="" F S Z=$O(^IBM(361.1,"B",IBIFN,Z),-1) Q:'Z I $P($G(^IBM(361.1,Z,0)),U,16)<2,$P(^(0),U,19) S $P(IB,U,2)=$P(^(0),U,19) Q
150 ;
151 Q IB
152 ;
153TEST(IBIFN) ; Returns 1 if bill IBIFN is a transmission test bill, 0 if not
154 Q +$S($G(^TMP("IBEDI_TEST_BATCH",$J)):1,1:+$P($G(^IBA(364,+$$LAST364(IBIFN),0)),U,7))
155 ;
Note: See TracBrowser for help on using the repository browser.