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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1IBTRD ;ALB/AAS - CLAIMS TRACKING - DENIAL/ APPEALS ; 10-AUG-1993
2 ;;2.0; INTEGRATED BILLING ;**1,199**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ;
6EN ; -- main entry point for IBT APPEAL/DENAIL EDITOR
7 I '$D(DT) D DT^DICRW
8 K XQORS,VALMEVL,IBTRD,DFN,IBCNS,IBTRN,IBTRV,IBTRC,IBFASTXT,VALMQUIT
9 D ASK
10 G:$D(VALMQUIT) ENQ
11 I IBTRD["DPT(" S IBTYPE="P",DFN=+IBTRD D EN^VALM("IBT APPEAL/DENIAL EDITOR") G ENQ
12 I IBTRD["DIC(" S IBTYPE="I",IBCNS=+IBTRD D EN^VALM("IBT APPEAL/DENIAL INS EDITOR")
13ENQ K XQORS,VALMEVL,IBTRD,DFN,IBCNS,IBTRN,IBTRV,IBTRC,IBFASTXT,VALMQUIT
14 K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
15 K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
16 D KVAR^VADPT
17 Q
18 ;
19HDR ; -- header code
20 I $G(IBTYPE)="P" D HDRP
21 I $G(IBTYPE)="I" D HDRI
22 Q
23 ;
24HDRI ; -- header code for by ins. co.
25 S VALMHDR(1)="Denials and Appeals for: "_$P(^DIC(36,+IBCNS,0),"^")
26 S VALMHDR(2)=" "
27 Q
28 ;
29HDRP ; -- header code for by pat.
30 D PID^VADPT
31 S VALMHDR(1)="Denials and Appeals for: "_$$PT^IBTUTL1(DFN)
32 S VALMHDR(2)=" "
33 Q
34 ;
35INIT ; -- init variables and list array
36 S U="^",VALMCNT=0,VALMBG=1
37 K ^TMP("IBTRC",$J),^TMP("IBTRCDX",$J)
38 K I,X,XQORNOD,DA,DR,DIE,DNM,DQ,IBTRC
39 I '$G(IBTRD),$G(DFN) S IBTRD=DFN_";DPT("
40 I '$G(IBTRD) S VALMQUIT=""
41 S IBTRSV=""
42 Q:$D(VALMQUIT)
43 ;
44BLD ; -- build list
45 K ^TMP("IBTRD",$J),^TMP("IBTRDDX",$J)
46 N IBI,J,IBTRC,IBTRCD,IBTRCD1,IBTRN
47 I IBTRD["DPT(" S IBTYPE="P",DFN=+IBTRD D BLDP
48 I IBTRD["DIC(" S IBTYPE="I",IBCNS=+IBTRD D BLDI
49 Q
50 ;
51BLDI ; -- Build list of appeals/denials by ins. co.
52 D HDRI
53 S (IBTRC,IBCNT,VALMCNT)=0
54 S IBDEN=$O(^IBE(356.7,"ACODE",20,0))
55 S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"AIACT",IBCNS,IBDEN,IBTRC)) Q:'IBTRC D 1
56 S IBPEN=$O(^IBE(356.7,"ACODE",30,0))
57 S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"AIACT",IBCNS,IBPEN,IBTRC)) Q:'IBTRC D 1
58 Q
59 ;
60BLDP ; -- Build list of appeals/denials by patient
61 D HDRP
62 S (IBTRC,IBCNT,VALMCNT)=0
63 S VALMSG=$$MSG^IBTUTL3(DFN)
64 S IBDEN=$O(^IBE(356.7,"ACODE",20,0))
65 S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"APACT",DFN,IBDEN,IBTRC)) Q:'IBTRC D 1
66 S IBPEN=$O(^IBE(356.7,"ACODE",30,0))
67 S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"APACT",DFN,IBPEN,IBTRC)) Q:'IBTRC D 1
68 Q
691 ; -- first add denial, then add appeal
70 S IBTRN=$P(^IBT(356.2,+IBTRC,0),"^",2)
71 S IBTRSV=+IBTRC
72 D 2
73 N IBTRC,IBTRCD,IBTRCD1
74 S IBAPEAL=$O(^IBE(356.11,"ACODE",60,0)) ; find appeals
75 S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"AP",IBTRSV,IBTRC)) Q:'IBTRC D 2
76 ;
77 Q
782 ; -- add items to list
79 S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
80 S IBTRCD1=$G(^IBT(356.2,+IBTRC,1))
81 Q:'+$P(IBTRCD,"^",19) ;quit if inactive
82 ;
83 ; -- if not the denial, must be from parent
84 I IBTRC'=IBTRSV&($P(IBTRCD,"^",18)'=IBTRSV) Q
85 ;
86 S IBCNT=IBCNT+1
87 W "."
88 I IBTYPE="I" S DFN=$P(IBTRCD,"^",5) D PID^VADPT
89 S X=""
90 S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
91 ;
92 I IBTYPE="I" D
93 .S X=$$SETFLD^VALM1($P(^DPT(DFN,0),"^"),X,"PATIENT")
94 .S X=$$SETFLD^VALM1(VA("BID"),X,"ID")
95 ;
96 I IBTYPE="P" D
97 .S X=$$SETFLD^VALM1($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),X,"INS CO")
98 .S X=$$SETFLD^VALM1($$GRP^IBCNS(+$P($G(^DPT(DFN,.312,+$P(IBTRCD1,"^",5),0)),"^",18)),X,"POLICY")
99 ;
100 S X=$$SETFLD^VALM1($P($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
101 I $P(IBTRCD,"^",11) S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),X,"ACTION")
102 I $P(IBTRCD,"^",11)="" S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^",3),X,"ACTION")
103 ;
104 S X=$$SETFLD^VALM1($P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),"^",18),0)),"^",2),X,"EVENT")
105 S X=$$SETFLD^VALM1($$DAT1^IBOUTL(+$P(^IBT(356,+IBTRN,0),"^",6),"2P"),X,"EV DATE")
106 S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4)),X,"TYPE")
107 S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",15),$P(IBTRCD,"^",16),IBTRN),3),X,"DAYS")
108 S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31)),X,"ROI")
109 S X=$$SETFLD^VALM1($P(IBTRCD,"^",6),X,"CONTACT")
110 S X=$$SETFLD^VALM1($P(IBTRCD,"^",7),X,"PHONE")
111 S X=$$SETFLD^VALM1($P(IBTRCD,"^",9),X,"REF NO")
112 D SET(X)
113 Q
114 ;
115SET(X) ; -- set arrays
116 S VALMCNT=VALMCNT+1
117 S ^TMP("IBTRD",$J,VALMCNT,0)=X
118 S ^TMP("IBTRD",$J,"IDX",VALMCNT,IBCNT)=""
119 S ^TMP("IBTRDDX",$J,IBCNT)=VALMCNT_"^"_IBTRC
120 Q
121HELP ; -- help code
122 S X="?" D DISP^XQORM1 W !!
123 Q
124 ;
125EXIT ; -- exit code
126 K ^TMP("IBTRD",$J),^TMP("IBTRDDX",$J),IBTRD
127 D CLEAN^VALM10
128 Q
129 ;
130ASK ; -- ask for patient or ins. co.
131 N DIR
132 S DIR(0)="350.9,4.02",DIR("A")="Select Patient Name or Insurance Co."
133 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
134 D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G ASKQ
135 S IBTRD=Y
136 I +IBTRD<1 S VALMQUIT=""
137ASKQ Q
Note: See TracBrowser for help on using the repository browser.