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

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

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1IBCNSMM1 ;ALB/CMS -MEDICARE INSURANCE INTAKE (CONT) ; 11/8/06 9:32am
2 ;;2.0;INTEGRATED BILLING;**103,359**;21-MAR-94;Build 9
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6SETP(IBP) ; -- Stuff data fields in patient policy
7 ; Required Input:
8 ; IBP =A for Part A, B for Part B
9 ; DFN =pt. ien
10 ; IBCDFN =patient policy ien
11 ; IBNAME =Name of Insured
12 ; IBHICN =Subscriber ID
13 ; IBAEFF =Effective Date of Plan A
14 ; IBBEFF =Effective Date of Plan B
15 ; IBCNSP =Medicare (WNR) ien ^Part A ien ^Part B ien
16 ; IBCOBI =Coordination of Benefits (Internal value)
17 ;
18 N D,DA,DIE,DR,IBBDA,X,Y
19 I '$D(^DPT(DFN,.312,+IBCDFN,0)) G SETPQ
20 ;
21 ; -- Stuff the pt. policy fields
22 ; #2 *Group Number #.18 Group Plan
23 ; #6 Whose Ins. #.2 COB
24 ; #8 Effective Date of Policy #1 Sub. ID
25 ; #15 *Group Name #17 Name of Insured
26 ; #16 Pt. Relationship to Insured
27 ;
28 S DIE="^DPT("_DFN_",.312,",DA=+IBCDFN,DA(1)=DFN
29 S DR="2///"_$S(IBP="A":$P(IBCNSP,U,4),IBP="B":$P(IBCNSP,U,6),1:"")
30 S DR=DR_";17///"_IBNAME_";1///"_IBHICN
31 S DR=DR_";6///v;8///"_$S(IBP="A":$G(IBAEFF),IBP="B":$G(IBBEFF),1:"")
32 S DR=DR_";.2////"_IBCOBI_";15///"_$S(IBP="A":"PART A",IBP="B":"PART B",1:"")
33 S DR=DR_";16///01;.18////"_$S(IBP="A":+$P(IBCNSP,U,3),IBP="B":+$P(IBCNSP,U,5),1:"")
34 D ^DIE
35 ;
36 ; -- Update Insurance Event
37 S IBCOVP=$P($G(^DPT(DFN,.31)),U,11)
38 D BEFORE^IBCNSEVT S IBNEW=1
39 ;
40 ; -- Ask to Verify at this time
41 K DIR S DIR("A")="Verify Medicare (WNR) Part "_IBP_" Coverage Now"
42 S DIR("?")="Enter 'No' to not Verify Coverage at this time."
43 W ! S IBOK=0 D OK I 'IBOK G SETEV
44 ;
45 ; -- Check to see if Pt. Name = name of Insured
46 I IBNAME'=$P($G(^DPT(DFN,0)),U,1) D
47 .W !!,"WARNING: Patient Name: '"_$P($G(^DPT(DFN,0)),U,1)_"' DOES NOT MATCH"
48 .W !," Name of Insured: '"_IBNAME_"'.",!
49 ;
50 ; -- verify policy
51 S DIE="^DPT("_DFN_",.312,",DA=IBCDFN,DA(1)=DFN
52 S DR="1.03///NOW;1.04////"_DUZ D ^DIE
53 W !," PART "_IBP_" COVERAGE VERIFIED."
54 ;
55SETEV ; -- Update Insurance event
56 N X,Y
57 D COVERED^IBCNSM31(DFN,IBCOVP)
58 I $G(IBCDFN)>0,IBNEW=1 D AFTER^IBCNSEVT,^IBCNSEVT
59 ;
60SETPQ Q
61 ;
62 ;
63BUFF(IBP) ; -- Set IBBUF array with policy info for Buffer File
64 ; Return: IBBUF array
65 ; IBBUF(355.33 field #s)=corresponding policy, plan and company data
66 ; i.e. IBBUF(20.01)=Insurance Company Name
67 ; IBBUF(40.02)=Group Name
68 ; IBBUF(60.01)=DFN
69 ;
70 ; Input: DFN, IBCNSP, IBNAME, IBHICN, IBAEFF, IBBEFF, IBCOBI
71 ;
72 ; Auto stuff other fields
73 ;
74 N IBP0 K IBBUF S IBBUF=""
75 S IBBUF(.03)=$G(IBSOUR)
76 S IBBUF(20.01)=$P(IBCNSP,U,2)
77 S IBBUF(40.02)=$S(IBP="A":$P(IBCNSP,U,4),IBP="B":$P(IBCNSP,U,6),1:"")
78 S IBBUF(40.03)=IBBUF(40.02)
79 S IBBUF(60.01)=+DFN
80 S IBBUF(60.02)=$S(IBP="A":IBAEFF,IBP="B":IBBEFF,1:"")
81 S IBBUF(60.04)=IBHICN
82 S IBBUF(60.05)="v"
83 S IBBUF(60.06)="01"
84 S IBBUF(60.07)=IBNAME
85 S IBBUF(60.12)=IBCOBI
86 S IBBDA=$$ADDSTF^IBCNBES(1,DFN,.IBBUF)
87 I +IBBDA W !,?3,$P(IBCNSP,U,2)," PART "_IBP_" entry #"_+IBBDA_" added to Insurance Buffer File."
88 I 'IBBDA W !,*7,?3,"Warning: Could not add new policy Part "_IBP_" in Buffer File.",!,?13,"("_$P(IBBDA,U,2)_")",!
89 Q
90 ;
91OK ; -- ask okay
92 N DTOUT,DIROUT,DIRUT,DUOUT,X,Y
93 ; Returns:
94 ; IBQUIT=1 Exit user timedout
95 ; IBOK=1 Yes
96 ; IBOK=0 No
97 S IBQUIT=0,DIR(0)="Y",DIR("B")="YES" W !
98 I $G(DIR("A"))="" S DIR("A")="Is this Data Correct"
99 I $G(DIR("?"))="" S DIR("?")="Enter 'No' to edit Medicare Card information"
100 D ^DIR K DIR
101 I $D(DTOUT) S IBQUIT=1
102 S IBOK=$G(Y) I IBOK["^" S IBQUIT=1
103 Q
104 ;
105GETWNR() ; -- Find and return the MEDICARE (WNR) ien
106 ; -- Returns Error message or
107 ; DIC(36 IEN ^"MEDICARE (WNR)"^IBA(355.3 PART A IEN ^"PART A"^ IBA(355.3 PART B IEN ^"PART B"
108 ;
109 N IBWNR,IB0,IBP0,IBQ,IBPQ,IBPX,IBX,IBY,IBPGN
110 S IBY="MEDICARE (WNR)",IBQ=0
111 S IBX=0 F S IBX=$O(^DIC(36,"B",IBY,IBX)) Q:('IBX) D Q:IBQ
112 .S IB0=$G(^DIC(36,IBX,0))
113 .K IBWNR("INS")
114 .I $P(IB0,U,1)'=IBY Q ;name
115 .I $P(IB0,U,2)'="N" Q ;Reimb?
116 .;I '$P(IB0,U,3) Q ;Sig Req. --> removed edit, cm, 5/18/99
117 .I $P(IB0,U,5) Q ;Inactive
118 .I $P($G(^IBE(355.2,+$P(IB0,U,13),0)),U)'="MEDICARE" Q ;Major Cat.
119 .S IBWNR("INS")=IBX_U_IBY
120 .;
121 .; -- Must have Active Group Plan Category Medicare Part A and B
122 .;
123 .K IBWNR("A"),IBWNR("B")
124 .S IBPX=0 F S IBPX=$O(^IBA(355.3,"B",IBX,IBPX)) Q:('IBPX)!(IBQ) D
125 ..S IBP0=$G(^IBA(355.3,IBPX,0))
126 ..I $P(IBP0,U,11) Q ;Inactive
127 ..I $P(IBP0,U,14)'="A",$P(IBP0,U,14)'="B" Q ;Not Plan Category Part A or B
128 ..S IBPGN=$TR($P(IBP0,U,3),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
129 ..I IBPGN'="PART A",IBPGN'="PART B" Q ;excludes non PART A and PART B plans
130 ..S IBWNR($P(IBP0,U,14))=IBPX_U_$P(IBP0,U,3)
131 ..I $G(IBWNR("A")),$G(IBWNR("B")) S IBQ=1
132 ;
133 S IBX=$G(IBWNR("INS"))_U_$G(IBWNR("A"))_U_$G(IBWNR("B"))
134 I 'IBX S IBX="Error: Standard Medicare (WNR) Insurance Company not setup properly." G GETWNRQ
135 I '$P(IBX,U,3) S IBX="Error: Standard Medicare (WNR) plan PART A not setup properly." G GETWNRQ
136 I '$G(IBWNR("B")) S IBX="Error: Standard Medicare (WNR) plan PART B not setup properly."
137GETWNRQ Q IBX
Note: See TracBrowser for help on using the repository browser.