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

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1IBTRCD ;ALB/AAS - CLAIMS TRACKING - EXPAND CONTACTS SCREEN ; 02-JUL-1993
2 ;;2.0;INTEGRATED BILLING;**210**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ;
6EN ; -- main entry point for IBT EXPAND/EDIT COMMUNICATIONS
7 I '$D(DT) D DT^DICRW
8 K XQORS,VALMEVL,IBTRC,IBTRD,IBTRV,IBTRN,DFN
9 I '$G(IBTRC) G EN^IBTRC
10 D EN^VALM("IBT EXPAND/EDIT COMMUNICATIONS")
11 Q
12 ;
13HDR ; -- header code
14 D PID^VADPT
15 S VALMHDR(1)="Expanded Insurance Reviews for: "_$$PT^IBTUTL1(DFN)_" ROI: "_$$EXPAND^IBTRE(356,.31,$P($G(^IBT(356,+$G(IBTRN),0)),"^",31))
16 S VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
17 Q
18 ;
19INIT ; -- init variables and list array
20 N IBTRCD,IBTRCD1
21 K VALMQUIT
22 S VALMCNT=0,VALMBG=1
23 D BLD,HDR
24 Q
25 ;
26BLD ; -- build display
27 K ^TMP("IBTRCD",$J),^TMP("IBTRCDDX",$J)
28 D KILL^VALM10()
29 S IBTRCD=$G(^IBT(356.2,IBTRC,0)),IBTRCD1=$G(^IBT(356.2,IBTRC,1))
30 S IBTRND=$G(^IBT(356,IBTRN,0))
31 F I=1:1:27 D BLANK^IBTRED(.I)
32 S VALMCNT=27
33 D ACTION,EN^IBTRCD0
34 Q
35 ;
36 ;
37ACTION ; -- Ins. Action infomation display
38 N OFFSET,START,TCODE,IBACTION,IBLCNT
39 S START=1,OFFSET=45,IBLCNT=0
40 D SET^IBCNSP(START,OFFSET," Action Information ",IORVON,IORVOFF)
41 D SET^IBCNSP(START+1,OFFSET," Type Contact: "_$$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4)))
42 S TCODE=$$TCODE^IBTRC(IBTRC) I TCODE D @TCODE
43 Q
4410 ; -- pre-cert contact
4515 ; -- admission review
4620 ; -- urgent/emergent ins. contact
4730 ; -- continued stay contact
48 S IBLCNT=2
49 D SET^IBCNSP(START+IBLCNT,OFFSET," Action: "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)))
50 S IBACTION=$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)
51 S IBACTION=IBACTION+100 D @IBACTION
52 S IBLCNT=IBLCNT+1
53 Q
54 ;
5540 ; -- Discharge contact
56100 ; -- No type of action
57 Q
5850 ; -- outpatient treatment
59 S IBLCNT=2
60 D SET^IBCNSP(START+IBLCNT,OFFSET," Opt Treatment: "_$$EXPAND^IBTRE(356.2,.26,$P(IBTRCD,"^",26)))
61 S IBLCNT=IBLCNT+1
62 D SET^IBCNSP(START+IBLCNT,OFFSET," Action: "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)))
63 S IBLCNT=IBLCNT+1
64 D SET^IBCNSP(START+IBLCNT,OFFSET," Auth. Number: "_$P(IBTRCD,"^",28))
65 ;D SET^IBCNSP(START+IBLCNT,OFFSET,"Treatment Auth: "_$$EXPAND^IBTRE(356.2,.27,$P(IBTRCD,"^",27)))
66 Q
6760 ; -- Appeal
6865 ; -- Nth appeal
69 D SET^IBCNSP(START+2,OFFSET," Appeal Type: "_$$EXPAND^IBTRE(356.2,.23,$P(IBTRCD,"^",23)))
70 D SET^IBCNSP(START+3,OFFSET," Case Status: "_$$EXPAND^IBTRE(356.2,.1,$P(IBTRCD,"^",10)))
71 D SET^IBCNSP(START+4,OFFSET,"No Days Pending: "_$$EXPAND^IBTRE(356.2,.25,$P(IBTRCD,"^",25)))
72 D SET^IBCNSP(START+5,OFFSET," Final Outcome: "_$$EXPAND^IBTRE(356.2,.29,$P(IBTRCD,"^",29)))
73 Q
7470 ; -- Patient
7580 ; -- Other
7685 ; -- Insurance verification
77 Q
78 ;
79110 ; -- approval actions
80 S IBLCNT=IBLCNT+1
81 D SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized From: "_$S($P(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",12))))
82 S IBLCNT=IBLCNT+1
83 D SET^IBCNSP(START+IBLCNT,OFFSET," Authorized To: "_$S($P(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",13))))
84 S IBLCNT=IBLCNT+1
85 D SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized Diag: "_$$DIAG^IBTRE6($P(IBTRCD,"^",14),1,$$TRNDATE^IBACSV($G(IBTRN))))
86 S IBLCNT=IBLCNT+1
87 D SET^IBCNSP(START+IBLCNT,OFFSET," Auth. Number: "_$P(IBTRCD,"^",28))
88 Q
89120 ; -- denial actions
90 S IBLCNT=IBLCNT+1
91 D SET^IBCNSP(START+IBLCNT,OFFSET," Denied From: "_$S($P(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",15))))
92 S IBLCNT=IBLCNT+1
93 D SET^IBCNSP(START+IBLCNT,OFFSET," Denied To: "_$S($P(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",16))))
94 S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,12,IBI)) Q:'IBI!(IBLCNT>6) D
95 .S IBLCNT=IBLCNT+1
96 .D SET^IBCNSP(START+IBLCNT,OFFSET," Denial Reasons: "_$$EXPAND^IBTRE(356.212,.01,+$G(^IBT(356.2,IBTRC,12,IBI,0))))
97 Q
98130 ; -- penalty
99 S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,13,IBI)) Q:'IBI!(IBLCNT>6) D
100 .S IBLCNT=IBLCNT+1
101 .D SET^IBCNSP(START+IBLCNT,OFFSET," Penalty: "_$$EXPAND^IBTRE(356.213,.01,+$G(^IBT(356.2,IBTRC,13,IBI,0))))
102 Q
103140 ; -- case pending
104 S IBLCNT=IBLCNT+1
105 D SET^IBCNSP(START+IBLCNT,OFFSET," Case Pending: "_$$EXPAND^IBTRE(356.2,.2,$P(IBTRCD,"^",20)))
106 Q
107150 ; -- no coverage
108 S IBLCNT=IBLCNT+1
109 D SET^IBCNSP(START+IBLCNT,OFFSET," No Coverage: "_$$EXPAND^IBTRE(356.2,.21,$P(IBTRCD,"^",21)))
110 Q
111 ;
112 ;
113HELP ; -- help code
114 S X="?" D DISP^XQORM1 W !!
115 Q
116 ;
117EXIT ; -- exit code
118 K VALMQUIT,IBTRC,IBTRCD,IBTRCD1
119 K ^TMP("IBTRCD",$J),^TMP("IBTRCDDX",$J)
120 D CLEAN^VALM10,FULL^VALM1
121 Q
Note: See TracBrowser for help on using the repository browser.