source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSMM.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1IBCNSMM ;ALB/CMS -MEDICARE INSURANCE INTAKE ; 18-OCT-98
2 ;;2.0;INTEGRATED BILLING;**103,133,184**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6EN ; -- Entry point from Medicare Intake Standalone option
7 N DIC,DIR,DA,%A,DFN,X,Y,IBQUIT,IBCNSP,IBSOURCE
8 S (IBQUIT,IBCNSP)=0 D GETWNR I IBQUIT G ENQ
9 ;
10 ; - allow the user to enter the Source of Information for the policies
11 W !!,"You may enter the 'Source of Information' that will be filed with all"
12 W !,"Medicare insurance coverage policies that are created.",!
13 ;
14 S DIR(0)="2.312,1.09"
15 S DIR("A")="Enter Source of Information"
16 S DIR("B")="INTERVIEW"
17 D ^DIR K DUOUT,DTOUT,DIRUT,DIROUT,DIR
18 S IBSOURCE=+Y I Y<1 G ENQ
19 W !
20 ;
21 ; - loop to select patients
22ENA S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC
23 I +Y<1 G ENQ
24 S DFN=+Y
25 I $G(^DPT(DFN,.35)) W *7,!!,?10,"Patient Expired on ",$$FMTE^XLFDT($P(^DPT(DFN,.35),U))
26 W ! D DISP^IBCNS W !,?3 S X="",$P(X,"=",76)="" W X
27 D ENR(DFN,IBSOURCE,1) K DIC W !! G ENA
28 ;
29ENQ Q
30 ;
31 ;
32ENR(DFN,IBSOUR,IBOPT) ; -- Entry point from IBCNBME Patient Registration or Pre-Registration
33 ; Input Variable DFN Required and IBSOUR =Source of Information
34 ; IBOPT =1 if comming from MII Standalone Option
35 ;
36 N D,DIE,DA,DIR,DIC,E,IBCPOL,IBCNSP,IBCDFN,IBQUIT,IBOK,IBC0,IBAD,IBGRP,IBADPOL
37 N IBNAME,IBHICN,IBAEFF,IBBEFF,IBCOVP,IBGNA,IBGNU,IBBUF,IBNEW,IBP,X,Y
38 N IBPOLA,IBPOLB,IBARR,IBHIT,IBHITA,IBHITB,IBCOB,IBCOBI
39 ;
40 S (IBAEFF,IBBEFF,IBCNSP,IBCDFN,IBNEW,IBQUIT)=0,IBADPOL=1
41 S (IBNAME,IBHICN)=""
42 ;
43 ; -- Get Standard Medicare Insurance Company and plans in IBCNSP
44 D GETWNR I IBQUIT G ENRQ
45 ;
46 ; -- get the patient's Medicare policies
47 S (IBPOLA,IBPOLB)=0
48 S IBCDFN=0 F S IBCDFN=$O(^DPT(DFN,.312,"B",+IBCNSP,IBCDFN)) Q:'IBCDFN D
49 .S IBCPOL=$G(^DPT(DFN,.312,IBCDFN,0))
50 .;
51 .; - is the policy for Part A?
52 .I $P(IBCNSP,U,3)=$P(IBCPOL,U,18) D Q
53 ..S IBPOLA=IBPOLA+1,IBARR("A",IBPOLA)=IBCDFN_"^"_IBCPOL
54 .;
55 .; - is the policy for Part B?
56 .I $P(IBCNSP,U,5)=$P(IBCPOL,U,18) D
57 ..S IBPOLB=IBPOLB+1,IBARR("B",IBPOLB)=IBCDFN_"^"_IBCPOL
58 ;
59 ; - can't edit here if there is more than one policy
60 I $D(IBARR("A",2)) K IBARR("A") D
61 .W !!,"This patient has more than one Part A policy. Please edit in Ins Mgmt."
62 ;
63 I $D(IBARR("B",2)) K IBARR("B") D
64 .W !!,"This patient has more than one Part B policy. Please edit in Ins Mgmt."
65 ;
66 I (IBPOLA!IBPOLB),'$D(IBARR) G ENRQ
67 ;
68 ; -- Ask for Medicare Insurance Card information
69 ; Return IBNAME, IBHICN, IBAEFF, IBBEFF, IBCOB/IBCOBI
70 D MII^IBCNSMM2 I IBQUIT G ENRQ
71 ;
72 ; - if Part A or B exists, but no changes, quit
73 I $D(IBARR("A",1)) D COM($P(IBARR("A",1),"^",2,99),"A") I IBHIT D
74 .S IBHITA=1 W !," * No Part A changes made..."
75 ;
76 I $D(IBARR("B",1)) D COM($P(IBARR("B",1),"^",2,99),"B") I IBHIT D
77 .S IBHITB=1 W !," * No Part B changes made..."
78 ;
79 I $G(IBHITA),$G(IBHITB) G ENRQ
80 I $G(IBHITA),'$G(IBBEFF) G ENRQ
81 I $G(IBHITB),'$G(IBAEFF) G ENRQ
82 ;
83 ; -- If user not holding key set data in Buffer File
84 I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D G ENRQ
85 .I IBAEFF,'$G(IBHITA) D BUFF^IBCNSMM1("A")
86 .I IBBEFF,'$G(IBHITB) D BUFF^IBCNSMM1("B")
87 ;
88 ; -- Otherwise, set data into permanent files
89 I IBAEFF,'$G(IBHITA) D
90 .I IBPOLA,'$D(IBARR("A")) Q ; can't update Part A policy
91 .I '$D(IBARR("A",1)) D ADDP("A") Q
92 .S IBCDFN=+IBARR("A",1) D SETP^IBCNSMM1("A")
93 I IBBEFF,'$G(IBHITB) D
94 .I IBPOLB,'$D(IBARR("B")) Q ; can't update Part B policy
95 .I '$D(IBARR("B",1)) D ADDP("B") Q
96 .S IBCDFN=+IBARR("B",1) D SETP^IBCNSMM1("B")
97 ;
98ENRQ W ! Q
99 ;
100 ;
101 ;
102ADDP(IBP) ; -- Create a new patient policy
103 ; Input: DFN
104 ; IBCNSP=MED WNR INS IEN^MEDICARE (WNR)
105 ; ^PART A IEN^PART A
106 ; ^PART B IEN^PART A
107 ; IBP = "A" or "B" for medicare part
108 ; IBSOUR = Source of Information
109 ; Return: IBCDFN=-1 could not add OR Policy ien
110 ; IBCOVP= Covered by Health Insurance
111 ;
112 N X,Y,DO,DD,DA,DR,DIC,DIE,DIK,DIR,DIRUT,IBSPEC
113 ; -- Create a New patient policy
114 S IBCOVP=$P($G(^DPT(DFN,.31)),U,11)
115 ;
116 D FIELD^DID(2,.3121,"","SPECIFIER","IBSPEC")
117 S DIC("DR")="1.09////"_IBSOUR_";1.05///NOW;1.06////"_DUZ,DIC("P")=$G(IBSPEC("SPECIFIER"))
118 K DD,DO S DA(1)=DFN,DIC="^DPT("_DFN_",.312,",DIC(0)="L",X=+IBCNSP,DLAYGO=2.312
119 D FILE^DICN K DD,DO,DLAYGO,DIC
120 S IBCDFN=+Y
121 I IBCDFN<1 W !!,*7," <Could not create new policy at this time. Try Later!>",! G ADDPQ
122 ;
123 ; -- Set Medicare policy data
124 D SETP^IBCNSMM1(IBP)
125ADDPQ Q
126 ;
127 ;
128GETWNR ;
129 ; -- Get Medicare (WNR) insurance company and plan data
130 ; Returns IBCNSP or IBQUIT
131 ; IBCNSP="Error: Medicare (WNR) ... not setup properly"
132 ; if Medicare WNR entry or plans not setup properly
133 ;
134 ; IBCNSP=INS CO. (36) IEN^"MEDICARE (WNR)"
135 ; ^PLAN (355.3) PARTA IEN^"PART A"
136 ; ^PLAN (355.3) PARTB IEN^"PART B"
137 ;
138 I 'IBCNSP S IBCNSP=$$GETWNR^IBCNSMM1
139 I 'IBCNSP W !!,*7,?3,IBCNSP S IBQUIT=1
140 Q
141 ;
142VALHIC(X) ; Edits for validating HIC #
143 ; X = the HIC # to be validated
144 N VAL
145 S VAL=1
146 I X'?9N1A.1AN,X'?1.3A6N,X'?1.3A9N S VAL=0
147 Q VAL
148 ;
149COM(X,Y) ; Compare X with the intake variables.
150 ; Input: X => 0th node of policy in file #2.312
151 ; Y => A (Part A) or B (part B)
152 ; Output: IBHIT=1 (no changes made)
153 S IBHIT=0
154 I $P(X,"^",17)'=IBNAME G COMQ
155 I $P(X,"^",2)'=IBHICN G COMQ
156 I $P(X,"^",8)'=$S(Y="A":IBAEFF,1:IBBEFF) G COMQ
157 I $P(X,"^",20)'=IBCOBI G COMQ
158 ;
159 S IBHIT=1
160COMQ Q
Note: See TracBrowser for help on using the repository browser.