| 1 | IBCNSJ12 ;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 | ;
|
|---|
| 5 | GETPL ; 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 | ;
|
|---|
| 24 | ADD ; - 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 | ;
|
|---|
| 31 | NAC(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)
|
|---|
| 44 | NACQ Q
|
|---|
| 45 | ;
|
|---|
| 46 | MSG(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
|
|---|
| 96 | MSGQ K ^TMP($J,"IBSUBS"),^TMP($J,"IBSUB-LIST")
|
|---|
| 97 | Q
|
|---|
