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

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IBCNSJ21 ;ALB/CPM - CHANGE POLICY PLAN (CON'T) ; 12-JAN-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5NOTES ; Display any necessary notes to the user.
6 N IBS S IBS=0
7 S IBIP='$P(IBPLAND,"^",2) I IBIP S IBS=1 W !,"Please note that this is an Individual Plan."
8 I $P(IBPLAND,"^",11) S IBS=1 W !,*7,"This plan is currently inactive."
9 D BU I $O(IBBU(0)) S IBS=1 W !,*7,"There are Benefits Used associated with this plan!"
10 I $O(^IBA(355.7,"APP",DFN,IBCDFN,0)) S IBS=1 W !,*7,"This patient has riders associated with this policy!"
11 I $$IR(DFN,IBCDFN) S IBS=1 W !,*7,"There are insurance reviews associated with this policy."
12 W:IBS !
13 Q
14 ;
15BU ; Are there any benefits used for this plan and policy?
16 ; Input variables required:
17 ; DFN -- ptr to patient in file #2
18 ; IBPLAN -- ptr to policy plan in file #355.3
19 ; IBCDFN -- ptr to policy in sub-file #2.312
20 ;
21 ; Output variable array:
22 ; IBBU(X)=Y -- array of benefits used associated with the policy,
23 ; where X is the benefit year, and Y points to the bu
24 ; in file #355.5
25 N DATE,POL
26 S DATE="" F S DATE=$O(^IBA(355.5,"APPY",DFN,IBPLAN,DATE)) Q:DATE="" D
27 .S POL=0 F S POL=$O(^IBA(355.5,"APPY",DFN,IBPLAN,DATE,POL)) Q:'POL I POL=IBCDFN S IBBU(-DATE)=$O(^(POL,0))
28 Q
29 ;
30AB ; Find all Annual Benefits associated with an Insurance Plan.
31 ; Input variables required:
32 ; IBCPOL -- ptr to proposed plan in file #355.3
33 ;
34 ; Output variable array:
35 ; IBAB(X) -- array of annual benefits, where X is the benefit year
36 ;
37 N X S X=""
38 F S X=$O(^IBA(355.4,"APY",IBCPOL,X)) Q:X="" S IBAB(-X)=""
39 Q
40 ;
41IR(DFN,IBCDFN) ; Are there any Insurance reviews associated with the policy?
42 ; Input: DFN -- Pointer to the patient in file #2
43 ; IBCDFN -- Pointer to the policy in file #2.312
44 ; Output: 1 -- There are associated insurance reviews, or
45 ; 0 -- there are not.
46 N X,Y S X=0
47 I $G(DFN),$G(IBCDFN) S Y=0 F S Y=$O(^IBT(356.2,"D",DFN,Y)) Q:'Y I $P($G(^IBT(356.2,Y,1)),"^",5)=IBCDFN S X=1 Q
48 Q X
49 ;
50DMBU ; Display mergeable benefits used.
51 N IBMRG
52 S X=0 F S X=$O(IBAB(X)) Q:'X S IBMRG(X)=""
53 S X=0 F S X=$O(IBBU(X)) Q:'X S IBMRG(X)=""
54 W !!," Existing Benefit Used Yr",?31,"Annual Benefit for Proposed Plan",?66,"Merge BU?",!
55 S X=0 F S X=$O(IBMRG(X)) Q:'X D
56 .W ! W:$D(IBBU(X)) ?6,$$DAT2^IBOUTL(X) W:$D(IBAB(X)) ?40,$$DAT2^IBOUTL(X)
57 .W ?69 I '$D(IBAB(X)) W "NO" S IBMRGN=1 Q
58 .I '$D(IBBU(X)) W "-na-" Q
59 .S IBMRGF(X)=IBBU(X) W "YES"
60 Q
61 ;
62MD ; Merge/delete benefits used, if necessary.
63 I $G(IBMERGE) D
64 .W !,"Merging previous benefits used into the new plan... "
65 .S IBX="" F S IBX=$O(IBMRGF(IBX)) Q:IBX="" D MERG^IBCNSJ13(IBCPOL,+IBMRGF(IBX)) K IBBU(IBX)
66 .W "done."
67 ;
68 ; - delete any remaining benefits used
69 I $O(IBBU(0)) D
70 .W !,"Deleting previous benefits used... "
71 .S IBX="" F S IBX=$O(IBBU(IBX)) Q:IBX="" D DBU^IBCNSJ(IBBU(IBX))
72 .W "done."
73MDQ Q
74 ;
75HLSW ; Reader help for switching plans.
76 W !!,"If you wish to change the subscribed-to plan the newly-",$S($G(IBNEWP):"added",1:"selected")," plan,"
77 W !,"enter 'YES'. Otherwise, enter 'NO'."
78 Q:'$O(IBBU(0))
79 W !!,"If you change the plan for this policy, "
80 I '$G(IBMERGE)!'$O(IBMRGF(0)) W "all existing benefits will be deleted." Q
81 I '$G(IBMRGN) W "all existing benefits will be merged." Q
82 W "all transferable benefits",!,"will be merged. All others will be deleted."
83 Q
Note: See TracBrowser for help on using the repository browser.