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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1IBCNSM2 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT ROUTINE ; 22-OCT-92
2 ;;2.0;INTEGRATED BILLING;**28,103,139**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% S U="^"
6 ;
7BU ; -- Enter Edit benefits already used
8 D FULL^VALM1
9 N I,J,IBXX,VALMY,IBCNS,IBCPOL,IBCDFN
10 D EN^VALM2($G(XQORNOD(0)))
11 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
12 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
13 .Q:IBPPOL=""
14 .S IBCNS=+$P(IBPPOL,"^",5),IBCPOL=+$P(IBPPOL,"^",22),IBCDFN=+$P(IBPPOL,"^",4)
15 .D EN^VALM("IBCNS BENEFITS USED BY DATE")
16 .Q
17 S VALMBCK="R" Q
18 ;
19EP ; -- Enter Edit Patient Insurance Policy Information
20 ;
21 S VALMBCK="R" Q
22 ;
23EI ; -- Enter Edit Insurance Company Information
24 ; -- if coming from benefit screen
25 ; ibcns=insurance co number
26 D FULL^VALM1
27 I $G(IBCNS)>0 D EN^VALM("IBCNS INSURANCE COMPANY") G EIQ
28 ;
29 ; -- if coming from list of policies, allow selection
30 N I,J,IBXX,IBCNS,VALMY
31 D EN^VALM2($G(XQORNOD(0)))
32 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
33 .S I=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
34 .S IBCNS=$P(I,"^",5)
35 .D EN^VALM("IBCNS INSURANCE COMPANY")
36EIQ S VALMBCK="R" Q
37 ;
38VC ; -- Verify Insurance Coverage
39 D FULL^VALM1
40 N I,J,IBXX,VALMY
41 ;
42 ; -- If no effective policies ask to verify no coverage
43 I '$$EPOL(DFN) D VCN G EXIT
44 ;
45 D EN^VALM2($G(XQORNOD(0)))
46 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
47 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
48 .Q:IBPPOL="" D VFY
49 ;
50EXIT ; -- Kill variables, refresh screen
51 ;
52 D BLD^IBCNSM
53 K I,J,IBXX,DA,DR,IBDUZZ
54 S VALMBCK="R" Q
55 ;
56VFY ; -- Display most recent verification
57 ;
58 N DA,DR,IBDUZ,IB0,IBWNR
59 D FULL^VALM1
60 S IBCH=$P(IBPPOL,U,1)
61 S IBWNR=$$GETWNR^IBCNSMM1()
62 ;
63 ; -- If Medicare WNR and Name of Insured is different from Pt. Name
64 ; display Warning message.
65 S IB0=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0))
66 I +IBWNR=+IB0 D
67 .I $P(IB0,U,17)="" Q
68 .I $P(IB0,U,17)=$P($G(^DPT(DFN,0)),U,1) Q
69 .W !!,"WARNING: Patient Name: '"_$P($G(^DPT(DFN,0)),U,1)_"' DOES NOT MATCH"
70 .W !," Name of Insured: '"_$P(IB0,U,17)_"' for this "_$P(IBWNR,U,2)_" policy."
71 ;
72 S IBDUZ=$P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,4)
73 I 'IBDUZ D REVASK Q
74 W !!," "_IBCH_" LAST VERIFIED BY "_$P($G(^VA(200,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3))_". . ."
75 I $P($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3),".")=DT W !,"COVERAGE VERIFIED TODAY, "_$$DAT1^IBOUTL(DT) H 3
76 E D REVASK
77 Q
78 ;
79REVASK ; -- Determine whether user wishes to re-verify
80 ;
81 N Y
82 W:'IBDUZ !
83 S DIR("B")="No",DIR(0)="YO",DIR("A")=$S('IBDUZ:" "_IBCH_" NEVER PREVIOUSLY VERIFIED. DO YOU WISH TO VERIFY COVERAGE",1:"ARE YOU RE-VERIFYING COVERAGE TODAY")
84 D ^DIR K DIR Q:$D(DIRUT)
85 I Y D REVFY
86 Q
87 ;
88REVFY ; -- Re-verify
89 ;
90 S DA(1)=DFN,DA=$P(IBPPOL,U,4),DIE="^DPT(DFN,.312,",DR="1.03////"_DT_";1.04////"_DUZ D ^DIE K DIE
91 S IBDUZ=$P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,4)
92 W !," "_IBCH_" VERIFIED BY "_$P($G(^VA(200,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3)) D PAUSE^VALM1
93 Q
94 ;
95VCN ; -- Ask to verifiy patient has no coverage
96 ;
97 N DA,DLAYGO,DIE,DIR,DR,DIRUT,DUOUT,DIOUT,DTOUT,IBADD,IBEXERR,IBWHER,X,Y
98 W !!,?5,"Patient has no effective insurance coverage on file."
99 S DIR("B")="No",DIR(0)="Y"
100 S DIR("A")=$S(+$G(^IBA(354,DFN,60)):"Re-v",1:"V")_"erify that patient has No Insurance Coverage "
101 S DIR("?")="Enter 'Yes' to enter a Verification of No Coverage Date"
102 D ^DIR
103 I Y D
104 .I '$D(^IBA(354,DFN)) D ADDP^IBAUTL6 I '$G(IBADD) W " <Try again Later>" Q
105 .S DA=DFN,DIE="^IBA(354,",DR=60 D ^DIE I $D(Y)=0 N IBX S IBX=$P($G(^DPT(DFN,.31)),"^",11) D
106 ..I X]""&(IBX'="N") S IBX="N",$P(^DPT(DFN,.31),"^",11)="N" D MSG
107 ..I X']""&(IBX'="U") S IBX="U",$P(^DPT(DFN,.31),"^",11)="U" D MSG
108 ..Q
109 Q
110 ;
111EPOL(DFN) ; Does the patient have any effective policies?
112 ; Input: DFN -- Pointer to the patient in file #2
113 ; Output: 0 -- The patient has no effective policies
114 ; 1 -- The patient has at least one effective policy
115 ;
116 N J,X,Y S Y=0
117 S J=0 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) D Q:Y
118 .I '$P(X,"^",4) S Y=1 Q
119 .I $P(X,"^",4)>DT S Y=1
120 Q Y
121 ;
122MSG ;If there is a change in the status of the covered by health insurance
123 ;field #11 in the Patient file #2, The user is notified of the change.
124 I '$D(ZTQUEUED) S VALMSG="COVERED BY HEALTH INSURANCE changed to '"_IBX_$S(IBX="U":"NKNOWN'",1:"O'")
125 Q
Note: See TracBrowser for help on using the repository browser.