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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1IBCNSP ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
2 ;;2.0;INTEGRATED BILLING;**6,28,43,52,85,251,363,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4% ;
5EN ; -- main entry point for IBCNS EXPANDED POLICY
6 N IB1ST
7 K VALMQUIT,IBPPOL
8 S IBTOP="IBCNSP"
9 D EN^VALM("IBCNS EXPANDED POLICY")
10 Q
11 ;
12HDR ; -- header code
13 N W,X,Y,Z
14 S VALMHDR(1)="Expanded Policy Information for: "_$E($P(^DPT(DFN,0),U),1,20)_" "_$P($$PT^IBEFUNC(DFN),U,2)
15 S Z=$G(^DPT(DFN,.312,+$P(IBPPOL,U,4),0))
16 S W=$P($G(^IBA(355.3,+$P(Z,U,18),0)),U,11)
17 S Y=$E($P($G(^DIC(36,+Z,0)),U),1,20)_" Insurance Company"
18 S X="** Plan Currently "_$S(W:"Ina",1:"A")_"ctive **"
19 S VALMHDR(2)=$$SETSTR^VALM1(X,Y,48,29)
20 Q
21 ;
22INIT ; -- init variables and list array
23 K VALMQUIT
24 S VALMCNT=0,VALMBG=1
25 I '$D(IBPPOL) D PPOL Q:$D(VALMQUIT)
26 K ^TMP("IBCNSVP",$J)
27 D BLD,HDR
28 Q
29 ;
30BLD ; -- list builder
31 K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPDX",$J)
32 D KILL^VALM10()
33 F I=1:1:20 D BLANK(.I) ; start with 20 blank lines
34 N IBCDFND,IBCDFND1,IBCDFND2,IBCDFND4,IBCDFND5
35 S IBCDFND=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0)),IBCDFND1=$G(^(1)),IBCDFND2=$G(^(2)),IBCDFND4=$G(^(4)),IBCDFND5=$G(^(5))
36 S IBCPOL=+$P(IBCDFND,U,18),IBCNS=+IBCDFND,IBCDFN=$P(IBPPOL,U,4)
37 S IBCPOLD=$G(^IBA(355.3,+$P(IBCDFND,U,18),0)),IBCPOLD1=$G(^(1))
38 S IBCPOLD2=$G(^IBA(355.3,+$G(IBCPOL),6)) ;; Daou/EEN adding BIN and PCN
39 ;
40 D POLICY^IBCNSP0 ; plan information
41 D INS^IBCNSP0 ; insurance company
42 D UR ; utilization review info
43 D EFFECT ; effective dates & source of info
44 D SUBSC^IBCNSP01 ; subscriber info
45 D EMP ; subscriber's employer info
46 D SPON^IBCNSP0 ; insured person's info
47 D ID^IBCNSP01 ; ins co ID numbers (IB*2*371)
48 D PLIM ; plan coverage limitations
49 D VER^IBCNSP01 ; user/verifier/editor info
50 D CONTACT^IBCNSP0 ; last insurance contact
51 D COMMENT ; comments - policy & plan
52 D RIDER^IBCNSP01 ; policy rider info
53 ;
54 S VALMCNT=+$O(^TMP("IBCNSVP",$J,""),-1)
55 Q
56 ;
57COMMENT ; -- Comment region
58 N START,OFFSET,IBL,IBI
59 S (START,IBL)=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
60 S IB1ST("COMMENT")=START
61 D SET(START,OFFSET," Comment -- Patient Policy ",IORVON,IORVOFF)
62 S IBL=IBL+1
63 D SET(IBL,OFFSET,$S($P(IBCDFND1,U,8)="":"None",1:$P(IBCDFND1,U,8)))
64 S IBL=IBL+1
65 D SET(IBL,OFFSET," ")
66 S IBL=IBL+1
67 D SET(IBL,OFFSET," Comment -- Group Plan ",IORVON,IORVOFF)
68 S IBI=0 F S IBI=$O(^IBA(355.3,+IBCPOL,11,IBI)) Q:IBI<1 D
69 . S IBL=IBL+1
70 . D SET(IBL,OFFSET," "_$E($G(^IBA(355.3,+IBCPOL,11,IBI,0)),1,80))
71 . Q
72 S IBL=IBL+1 D SET(IBL,OFFSET," ")
73 S IBL=IBL+1 D SET(IBL,OFFSET," ")
74 Q
75 ;
76EFFECT ; -- Effective date region
77 N START,OFFSET
78 S START=16,OFFSET=45
79 D SET(START,OFFSET-4," Effective Dates & Source ",IORVON,IORVOFF)
80 D SET(START+1,OFFSET," Effective Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,8)))
81 D SET(START+2,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,4)))
82 D SET(START+3,OFFSET," Source of Info: "_$$EXPAND^IBTRE(2.312,1.09,$P($G(IBCDFND1),U,9)))
83 D SET(START+4,OFFSET-4,"Policy Not Billable: "_$S($P($G(^DPT(DFN,.312,IBCDFN,3)),"^",4):"YES",1:"NO"))
84 Q
85 ;
86UR ; -- UR of insurance region
87 N START,OFFSET
88 S START=16,OFFSET=2
89 D SET(START,OFFSET," Utilization Review Info ",IORVON,IORVOFF)
90 D SET(START+1,OFFSET," Require UR: "_$$EXPAND^IBTRE(355.3,.05,$P(IBCPOLD,U,5)))
91 D SET(START+2,OFFSET," Require Amb Cert: "_$$EXPAND^IBTRE(355.3,.12,$P(IBCPOLD,U,12)))
92 D SET(START+3,OFFSET," Require Pre-Cert: "_$$EXPAND^IBTRE(355.3,.06,$P(IBCPOLD,U,6)))
93 D SET(START+4,OFFSET," Exclude Pre-Cond: "_$$EXPAND^IBTRE(355.3,.07,$P(IBCPOLD,U,7)))
94 D SET(START+5,OFFSET,"Benefits Assignable: "_$$EXPAND^IBTRE(355.3,.08,$P(IBCPOLD,U,8)))
95 Q
96EMP ; -- Insurance Employer Region
97 N OFFSET,START,IBADD
98 S START=24,OFFSET=40
99 D SET(START,OFFSET," Subscriber's Employer Information ",IORVON,IORVOFF)
100 D SET(START+1,OFFSET,"Emp Sponsored Plan: "_$S(+$P(IBCDFND2,U,10):"Yes",1:"No"))
101 D SET(START+2,OFFSET," Employer: "_$P(IBCDFND2,U,9))
102 D SET(START+3,OFFSET," Employment Status: "_$$EXPAND^IBTRE(2.312,2.11,$P(IBCDFND2,U,11)))
103 D SET(START+4,OFFSET," Retirement Date: "_$$DAT1^IBOUTL($P(IBCDFND2,U,12)))
104 D SET(START+5,OFFSET,"Claims to Employer: "_$S(+IBCDFND2:"Yes, Send to Employer",1:"No, Send to Insurance Company"))
105 ;
106 D SET(START+6,OFFSET," Street: "_$P(IBCDFND2,U,2)) S IBADD=1
107 I $P(IBCDFND2,U,3)'="" D SET(START+7,OFFSET," Street 2: "_$P(IBCDFND2,U,3)) S IBADD=2
108 I $P(IBCDFND2,U,4)'="" D SET(START+8,OFFSET," Street 3: "_$P(IBCDFND2,U,4)) S IBADD=3
109 D SET(START+6+IBADD,OFFSET," City/State: "_$E($P(IBCDFND2,U,5),1,15)_$S($P(IBCDFND2,U,5)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCDFND2,U,6),0)),U,2)_" "_$E($P(IBCDFND2,U,7),1,5))
110 D SET(START+7+IBADD,OFFSET," Phone: "_$P(IBCDFND2,U,8))
111 ;
112 ; couple of blank lines to end this section
113 D SET(START+8+IBADD,2," ")
114 D SET(START+9+IBADD,2," ")
115 ;
116EMPQ Q
117 ;
118PLIM ; plan coverage limitations/plan limitation category display
119 N START,END S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
120 S IB1ST("PLIM")=START
121 D LIMBLD^IBCNSC41(START,2)
122 S END=$O(^TMP("IBCNSVP",$J,""),-1) ; last line constructed
123 D SET(END+1,2," ") ; 2 blank lines to end this section
124 D SET(END+2,2," ")
125PLIMX ;
126 Q
127 ;
128HELP ; -- help code
129 S X="?" D DISP^XQORM1 W !!
130 Q
131 ;
132EXIT ; -- exit code
133 K IBPPOL,VALMQUIT,IBCNS,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,IBCDFND,IBCDFND1,IBCDFND2
134 D CLEAN^VALM10,CLEAR^VALM1
135 Q
136 ;
137EXPND ; -- expand code
138 Q
139 ;
140PPOL ; -- select patient, select policy
141 I '$D(DFN) D G:$D(VALMQUIT) PPOLQ
142 .S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC
143 .S DFN=+Y
144 I $G(DFN)<1 S VALMQUIT="" G PPOLQ
145 ;
146 I '$O(^DPT(DFN,.312,0)) W !!,"Patient doesn't have Insurance" K DFN G PPOL
147 ;
148 S DIC="^DPT("_DFN_",.312,",DIC(0)="AEQMN",DIC("A")="Select Patient Policy: "
149 D ^DIC I +Y<1 S VALMQUIT=""
150 G:$D(VALMQUIT) PPOLQ
151 S IBPPOL="^2^"_DFN_U_+Y_U_$G(^DPT(DFN,.312,+Y,0))
152PPOLQ K DIC Q
153 ;
154BLANK(LINE) ; -- Build blank line
155 D SET^VALM10(.LINE,$J("",80))
156 Q
157 ;
158SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array
159 I '$D(@VALMAR@(LINE,0)) D BLANK(.LINE) S VALMCNT=$G(VALMCNT)+1
160 D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT)))
161 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF))
162 W:'(LINE#5) "."
163 Q
Note: See TracBrowser for help on using the repository browser.