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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1IBCNSJ4 ;ALB/CPM - INACTIVATE MULTIPLE INSURANCE PLANS ; 20-MAR-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28,62**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; Inactivate/Delete Multiple Plans
6 N DFN,IBAB,IBSEL,IBCDFN,IBSUB,IBBUM,IBBUD,IBBUMC
7 N IBCPOL,IBDAT,IBDATP,IBCDFN1,IBBU,IBABDAT,IBINACTM,Y
8 W !!,"This process will allow you to transfer subscribers from many insurance"
9 W !,"plans into one 'master' plan. After the subscribers from each selected"
10 W !,"plan are transferred to the master plan, the selected plan will be deleted"
11 W !,"from your system."
12 W !!,"You should be very careful when you use this tool."
13 W !!,"You must first select the master plan into which you will transfer all"
14 W !,"selected plan subscribers. This plan must be an active group plan.",!
15 ;
16 ; - select/display the master plan
17 S Y=0,IBINACTM=1 D SEL4^IBCNSJ14 G:IBQUIT ENQ
18 S IBPLAND=$G(^IBA(355.3,IBPLAN,0)) D MSTR
19 ;
20 ; - check annual benefits
21 S X="" F S X=$O(^IBA(355.4,"APY",IBPLAN,X)) Q:X="" S IBAB(-X)=""
22 I $D(IBAB) W !!,"Annual Benefits have been established for this plan." G CONT
23 S DIR(0)="Y",DIR("A")="This plan has no Annual Benefits on file! Do you wish to continue"
24 S DIR("?")="If you wish to continue with this processing, enter 'YES.' Otherwise, enter 'NO.'"
25 W ! D ^DIR K DIR I 'Y K DIRUT,DTOUT,DUOUT,DIROUT G ENQ
26 ;
27CONT ; - explain next step
28 I '$D(IBAB) W !!,*7,"Please note that any Benefits Used on file for subscribers who",!,"will be merged into the master plan will be deleted!"
29 I $D(IBAB) D
30 .W !!,"Any Benefits Used on file for subscribers who will be merged into the"
31 .W !,"master plan will also be merged if the master plan has any Annual Benefits"
32 .W !,"dated in the same year as the Benefits Used. Please note that the"
33 .W !,"Benefits Used date will be changed to match the date of the Annual Benefit."
34 ;
35 W !!,"You may now select the plans to be merged into the master plan... (type <CR>)"
36 R X:DTIME
37 ;
38 ; - allow multiple plans to be selected
39 K ^TMP($J,"IBSEL") W !," ....hmmm..." D LKP^IBCNSU2(IBCNS,1,1,.IBSEL,0,1) I '$O(^TMP($J,"IBSEL",0)) W !!,"No plans were selected!" G ENQ
40 D MSTR S (X,Y)=0 F S X=$O(^TMP($J,"IBSEL",X)) Q:'X I X'=IBPLAN S Y=Y+1
41 W !!,"There ",$S(Y=1:"was ",1:"were "),$S(Y:Y,1:"no")," plan",$E("s",Y'=1)," selected to be merged into the master plan."
42 G:'Y ENQ
43 ;
44 ; - okay to go?
45 S DIR(0)="Y",DIR("A")="Okay to merge th"_$S(Y=1:"is",1:"ese")_" plan"_$S(Y=1:"",1:"s")_" into the master plan"
46 S DIR("?")="If you wish to merge the selected plans into the master plan, enter 'YES.' Otherwise, enter 'NO.'"
47 W ! D ^DIR K DIR I 'Y K DIRUT,DTOUT,DUOUT,DIROUT G ENQ
48 ;
49 W !!,"Merging each selected plan into the master plan...",!
50 S (IBSUB,IBBUD,IBBUM,IBBUMC)=0
51 S IBCPOL=0 F S IBCPOL=$O(^TMP($J,"IBSEL",IBCPOL)) Q:'IBCPOL I IBCPOL'=IBPLAN D
52 .W "." K ^TMP($J,"IBSUBS")
53 .S IBSUB=IBSUB+$$SUBS^IBCNSJ(IBCNS,IBCPOL,0,"^TMP($J,""IBSUBS"")")
54 .;
55 .; - move the subscribers and benefits used
56 .S DFN=0 F S DFN=$O(^TMP($J,"IBSUBS",DFN)) Q:'DFN D
57 ..S IBCDFN=0 F S IBCDFN=$O(^TMP($J,"IBSUBS",DFN,IBCDFN)) Q:'IBCDFN D
58 ...Q:$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)=IBPLAN
59 ...D SWPL^IBCNSJ13(IBPLAN,DFN,IBCDFN)
60 ...;
61 ...; - merge/change/delete previous benefits used
62 ...S IBDAT="" F S IBDAT=$O(^IBA(355.5,"APPY",DFN,IBCPOL,IBDAT)) Q:IBDAT="" D
63 ....S IBCDFN1=0 F S IBCDFN1=$O(^IBA(355.5,"APPY",DFN,IBCPOL,IBDAT,IBCDFN1)) Q:'IBCDFN1 I IBCDFN1=IBCDFN S IBBU=$O(^(IBCDFN1,0)) D
64 .....S IBDATP=-IBDAT,IBABDAT=$O(IBAB($E(IBDATP,1,3)_"0000"))
65 .....I $E(IBABDAT,1,3)'=$E(IBDATP,1,3) S IBBUD=IBBUD+1 D DBU^IBCNSJ(IBBU) Q
66 .....S IBBUM=IBBUM+1 S:IBABDAT'=IBDATP IBBUMC=IBBUMC+1
67 .....D MERG^IBCNSJ13(IBPLAN,IBBU,$S(IBABDAT'=IBDATP:IBABDAT,1:0))
68 .;
69 .; - delete the plan
70 .D DEL^IBCNSJ(IBCPOL)
71 ;
72 W !!,"All selected plans have been deleted."
73 W !,$S(IBSUB:IBSUB,1:"No")," subscriber",$S(IBSUB=1:" was",1:"s were")," transferred to the master plan."
74 W !,$S(IBBUD:IBBUD,1:"No")," Benefits Used record",$S(IBBUD=1:" was",1:"s were")," deleted."
75 W !,$S(IBBUM:IBBUM,1:"No")," Benefits Used record",$S(IBBUM=1:" was",1:"s were")," merged."
76 I IBBUM W " (",IBBUMC," had the date changed)"
77 ;
78ENQ K ^TMP($J,"IBSUBS"),^("IBSEL")
79 Q
80 ;
81 ;
82MSTR ; Display Master Plan Information
83 W !!?24,"*** M A S T E R P L A N ***"
84 W !,"Plan Company: ",$P($G(^DIC(36,IBCNS,0)),"^")
85 W !?3,"Plan Name: ",$S($P(IBPLAND,"^",3)]"":$P(IBPLAND,"^",3),1:"<unspecified>")
86 W !," Plan Number: ",$S($P(IBPLAND,"^",4)]"":$P(IBPLAND,"^",4),1:"<unspecified>")
87 Q
88 ;
89 ;
90ASK() ; Does the user wish to inactivate multiple plans?
91 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
92 S DIR(0)="Y",DIR("A")="Do you wish to delete multiple plans simultaneously"
93 S DIR("?")="If you wish to transfer subscribers from many duplicate plans into a master plan, enter 'YES.' To inactivate a single plan, enter 'NO.'"
94 W ! D ^DIR
95 Q $S($D(DIRUT)!$D(DUOUT):-1,1:+Y)
Note: See TracBrowser for help on using the repository browser.