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

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

revised back to 6/30/08 version

File size: 3.6 KB
Line 
1IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ; 22-OCT-92
2 ;;2.0;INTEGRATED BILLING;**6,28,40,43,52,85,103,361**;21-MAR-94;Build 9
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5% G EN^IBCNSP
6 ;
7EA ; -- Edit all
8 N IBCDFN,IBTRC,IBTRN
9 D FULL^VALM1 W !!
10 S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" G EAQ
11 S IBCNSEH=1 D PAT^IBCNSEH
12 ;
13 D BEFORE^IBCNSEVT
14 D PATPOL^IBCNSM32(IBCDFN)
15 D AFTER^IBCNSEVT,^IBCNSEVT
16 ;
17 ; -- edit policy data
18 D POL^IBCNSEH
19 D EDPOL^IBCNSM3(IBCDFN)
20 ;
21 W !! D AI
22 ;
23EAQ D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
24 D BLD^IBCNSP
25 S VALMBCK="R"
26 Q
27 ;
28AB ; -- Annual Benefits
29 S X=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,X,0)),IBCPOL=+$P($G(^(0)),"^",18)
30 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ABQ
31 D FULL^VALM1 W !!
32 D EN^VALM("IBCNS ANNUAL BENEFITS")
33 S VALMBCK="R"
34ABQ Q
35 ;
36BU ; -- Benefits Used
37 S IBCDFN=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,IBCDFN,0)),IBCPOL=+$P($G(^(0)),"^",18)
38 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G BUQ
39 D FULL^VALM1 W !!
40 D EN^VALM("IBCNS BENEFITS USED BY DATE")
41 S VALMBCK="R"
42BUQ Q
43 ;
44IT ; -- edit insurance type info from patient policy and plan edit
45 D FULL^VALM1 W !!
46 N IBCDFN
47 S IBCDFN=+$P($G(IBPPOL),"^",4),IBCPOL=+$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
48 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ITQ
49 D ITEDIT(IBCPOL,IBCDFN)
50ITQ S VALMBCK="R" Q
51 ;
52IT1 ; -- edit insurance type info from patient policy
53 D ITEDIT(IBCPOL)
54 S VALMBCK="R"
55 Q
56 ;
57ITEDIT(IBCPOL,IBCDFN) ;Edit insurance type info once you have plan (IBCPOL)
58 ; IBCDFN = the ifn of the policy multiple for pt in ^DPT, node .312
59 ; only defined for editing via patient policy
60 G:'$G(IBCPOL) ITEDITQ
61 D SAVE^IBCNSP3(IBCPOL)
62 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ITEDITQ
63 I $G(IBCDFN) S IBCNSEH=+$G(^IBE(350.9,1,4)) D POL^IBCNSEH
64 I $P($G(^IBA(355.3,IBCPOL,0)),"^",11) W !?2,*7,"Please note that this plan is inactive!",!
65 S DA=IBCPOL,DIE="^IBA(355.3,",DR=".05;.12;.06;.07;.08"
66 D ^DIE K DIC,DIE,DA,DR
67 D COMP^IBCNSP3(IBCPOL)
68 I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBCDFN) UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP D:'$G(IBCDFN) INIT^IBCNSC4
69 L -^IBA(355.3,+IBCPOL)
70ITEDITQ Q
71 ;
72ED ; -- Edit effective dates
73 D FULL^VALM1 W !!
74 N IBDIF,DA,DR,DIE,DIC
75 D BEFORE^IBCNSEVT
76 D SAVEPT^IBCNSP3(DFN,IBCDFN)
77 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EDQ
78 D VARS^IBCNSP3
79 S DR="8;3;1.09//;3.04"
80 D ^DIE K DIC,DIE,DA,DR
81 D COMPPT^IBCNSP3(DFN,IBCDFN) I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),AFTER^IBCNSEVT,^IBCNSEVT,BLD^IBCNSP
82 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
83EDQ S VALMBCK="R" Q
84 ;
85VC ; -- Verify Coverage
86 D FULL^VALM1 W !!
87 D VFY^IBCNSM2
88 D BLD^IBCNSP
89 S VALMBCK="R" Q
90 ;
91SU ; -- Subscriber Update
92 D FULL^VALM1 W !!
93 ;Patch 40
94 N IBDIF,DA,DR,DIC,DIE,DGSENFLG
95 S DGSENFLG=1
96 D SAVEPT^IBCNSP3(DFN,IBCDFN)
97 D VARS^IBCNSP3
98 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G SUQ
99 S DR="6;S IBAD=X;K X I '$$VET^IBCNSU1() S Y=""@10"";17///^S X=$P(^DPT(DFN,0),U);16///^S X=""01"""
100 S DR=DR_";S Y=""@20"";@10;17;16//^S X=$S(IBAD=""s"":""02"",1:"""");@20;1;.2;4.01;4.02;3.01;3.12;3.02;3.03;3.05:3.11"
101 D ^DIE K DIC,DIE,DA,DR
102 D COMPPT^IBCNSP3(DFN,IBCDFN)
103 I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
104 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
105SUQ S VALMBCK="R" Q
106 ;
107IC ; -- Insurance Contact Information
108 D FULL^VALM1 W !!
109 N IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN
110 D AI
111 D:$G(IBTRC) AIP^IBCNSP02(IBTRC),BLD^IBCNSP
112 S VALMBCK="R" Q
113 Q
114AI ; -- Add ins. verification entry
115 N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
116 Q:'$G(DFN)
117 Q:'$G(IBCDFN) S IBQUIT=0
118 D AI^IBCNSP02
119 Q
Note: See TracBrowser for help on using the repository browser.