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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1IBCNSJ12 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN (CON'T) ; 18-JAN-95
2 ;;2.0;INTEGRATED BILLING;**28,62,142**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GETPL ; Select an active group plan or add a new one.
6 ; Required variable input:
7 ; IBCNS -- Pointer to the company in file #36 offering the plan
8 ; IBPLAN -- Pointer to the current plan in file #355.3
9 ; IBFG -- [Optional] -> set to 1 to force creation, if
10 ; necessary, of a group plan
11 ;
12 ; Variable output:
13 ; IBCPOL -- 0 if no plan was selected/added, or
14 ; >0 points to the added/selected plan in file #355.3
15 ; IBNEWP -- [optional]: set to 1 if a new plan was added.
16 ;
17 N IBALR
18 S IBCPOL=0,IBALR=IBPLAN
19 I '$$ANYGP^IBCNSJ(IBCNS,IBPLAN) W !!,$P($G(^DIC(36,IBCNS,0)),"^")," offers no other active group plans!" G ADD
20 ;
21 ; - select an active group plan
22 S IBCPOL=$$LK^IBCNSM31(IBCNS) I 'IBCPOL W !,"No plan selected!",!
23 ;
24ADD ; - propose to add a new plan to which the patient may subscribe
25 I 'IBCPOL D
26 .W !,"You may ",$S($G(IBREP):"repoint these policies",1:"change the policy plan")," to a newly-added plan."
27 .D NEW^IBCNSJ3(IBCNS,.IBCPOL,+$G(IBFG)) W ! I IBCPOL S IBNEWP=1
28 I 'IBCPOL W !,"No Insurance Plan has been added or selected."
29 Q
30 ;
31NAC(IBPLAN,IBPR,IBDEL,IBQ) ; Inactivate the plan.
32 ; Input: IBPLAN -- Pointer to the plan in file #355.3
33 ; IBPR -- Prompt for the Reader call
34 ; IBDEL -- [optional]: set to 1 if the plan may be deleted
35 ; Output: IBQ -- set to 1 if the plan is not inactivated
36 ;
37 N DIR,DIRUT,DIROUT,DUOUT,DTOUT
38 I '$G(IBPLAN) G NACQ
39 S IBQ=0,DIR(0)="Y",DIR("?")="To inactivate this plan, answer 'YES.' Otherwise, answer 'NO.'"
40 S DIR("A")=$S($G(IBPR)]"":IBPR,1:"Is it okay to inactivate this plan")
41 W ! D ^DIR I 'Y W !,"The plan was not inactivated." D DELP^IBCNSJ11 S IBQ=1 G NACQ
42 W !,"Inactivating the plan... " D IRACT^IBCNSJ(IBPLAN,1) W "done."
43 I $G(IBDEL) D DEL^IBCNSJ11(IBPLAN)
44NACQ Q
45 ;
46MSG(IBCNS,IBPLAN) ; Send the subscription list to the user.
47 ; Input: IBCNS -- Pointer to the company in file #36 offering the plan
48 ; IBPLAN -- Pointer to the current plan in file #355.3
49 ;
50 N DFN,IBCDFN,IBCDFND,IBPLAND,IBC,IBSUB1,VA,VAOA,VAERR,XMDUZ,XMTEXT,XMY,XMSUB,IBX
51 I '$G(IBCNS)!'$G(IBPLAN) G MSGQ
52 S IBPLAND=$G(^IBA(355.3,IBPLAN,0)) I 'IBPLAND G MSGQ
53 W !,"Building the list of inactivated subscriptions to send to you..."
54 ;
55 ; - build message header
56 K ^TMP($J,"IBSUB-LIST")
57 S XMSUB="SUBSCRIPTION LIST FOR INACTIVATED PLAN"
58 S ^TMP($J,"IBSUB-LIST",1)="The following plan offered by "_$E($P($G(^DIC(36,+IBCNS,0)),"^"),1,20)_" has been inactivated:"
59 S ^TMP($J,"IBSUB-LIST",2)=" "
60 S IBX=" Group Plan Number: "_$S($P(IBPLAND,"^",4)]"":$P(IBPLAND,"^",4),1:"<no number>")
61 S ^TMP($J,"IBSUB-LIST",3)=$E(IBX_$J("",25),1,43)_"Plan Number: "_$S($P(IBPLAND,"^",3)]"":$P(IBPLAND,"^",3),1:"<no name>")
62 S ^TMP($J,"IBSUB-LIST",4)=" "
63 S ^TMP($J,"IBSUB-LIST",5)="The following plan subscriptions, which may have been active, were"
64 S ^TMP($J,"IBSUB-LIST",6)="automatically inactivated:"
65 S ^TMP($J,"IBSUB-LIST",7)=" "
66 S ^TMP($J,"IBSUB-LIST",8)="Patient Name/ID Whose Employer Effective Expires"
67 S ^TMP($J,"IBSUB-LIST",9)=" ",IBC=9
68 ;
69 ; - build message subscription list
70 K ^TMP($J,"IBSUBS")
71 S IBSUB1=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"^TMP($J,""IBSUBS"")")
72 S DFN=0 F S DFN=$O(^TMP($J,"IBSUBS",DFN)) Q:'DFN D
73 .D COV^IBCNSJ(DFN)
74 .S X=$$PT^IBEFUNC(DFN),IBM=1
75 .S X=$E($P(X,"^"),1,20)_" "_$P(X,"^",3)
76 .S IBC=IBC+1,^TMP($J,"IBSUB-LIST",IBC)=$E(X_$J("",28),1,28)
77 .S IBCDFN=0 F S IBCDFN=$O(^TMP($J,"IBSUBS",DFN,IBCDFN)) Q:'IBCDFN D
78 ..S IBCDFND=$G(^DPT(DFN,.312,IBCDFN,0))
79 ..I 'IBM S IBC=IBC+1,^TMP($J,"IBSUB-LIST",IBC)=$J("",28) S IBM=1
80 ..S X=$$EXPAND^IBTRE(2.312,6,$P(IBCDFND,"^",6))
81 ..S IBX=^TMP($J,"IBSUB-LIST",IBC)
82 ..S IBX=IBX_$E(X_$J("",9),1,9)
83 ..S VAOA("A")=$S($P(IBCDFND,"^",6)="s":6,1:5) D OAD^VADPT
84 ..S IBX=IBX_$E($E(VAOA(9),1,21)_$J("",22),1,22)
85 ..S IBX=IBX_$E($$DAT1^IBOUTL($P(IBCDFND,"^",8))_$J("",10),1,10)
86 ..S IBX=IBX_$E($$DAT1^IBOUTL($P(IBCDFND,"^",4))_$J("",10),1,10)
87 ..S ^TMP($J,"IBSUB-LIST",IBC)=IBX
88 ;
89 ; - build message trailer and transmit
90 S IBC=IBC+1,^TMP($J,"IBSUB-LIST",IBC)=" "
91 S IBC=IBC+1,^TMP($J,"IBSUB-LIST",IBC)="You should review this list and change the policy plan for any of"
92 S IBC=IBC+1,^TMP($J,"IBSUB-LIST",IBC)="these subscriptions if necessary."
93 S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="^TMP($J,""IBSUB-LIST"","
94 K XMY S XMY(DUZ)=""
95 D ^XMD
96MSGQ K ^TMP($J,"IBSUBS"),^TMP($J,"IBSUB-LIST")
97 Q
Note: See TracBrowser for help on using the repository browser.