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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IBCNSJ5 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING ; 09-AUG-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**43**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PL ; -- Insurance Company Plan List
6 D FULL^VALM1 W !!
7 N VALMY,VALMHDR,IBIND,IBMULT,IBW,IBSEL
8 S (IBIND,IBMULT)=1,IBW=1,IBSEL=0
9 D EN^VALM("IBCNS PLAN LIST")
10 Q
11 ;
12AB ; -- Edit Annual Benefits from insurance company edit OR plan detail edit
13 I $D(IBCPOL) D FULL^VALM1,EN^VALM("IBCNS ANNUAL BENEFITS") S VALMBCK="R" G ABQ
14 D FULL^VALM1
15 N I,J,IBXX,VALMY,IBCDFN
16 D EN^VALM2($G(XQORNOD(0)))
17 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
18 .N IBCPOL
19 .S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
20 .Q:IBCPOL=""
21 .D FULL^VALM1
22 .W !!,"Plan Name: ",$P($G(^IBA(355.3,IBCPOL,0)),U,3)," Number: ",$P($G(^IBA(355.3,IBCPOL,0)),U,4)
23 .K IBCDFN
24 .D EN^VALM("IBCNS ANNUAL BENEFITS")
25 .Q
26ABQ I $D(IBCPOL) D INIT^IBCNSC4
27 S VALMBCK=$S($D(IBFASTXT):"Q",1:"R") K IBFASTXT Q
28 ;
29IA ; -- (In)activate plan from insurance company edit OR plan detail edit
30 I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) W !!,"Sorry, but you do not have the required privileges to inactivate plans." D PAUSE^VALM1 G IAQ
31 D FULL^VALM1
32 I $D(IBCPOL) D INACT^IBCNSJ1(+$P($G(^IBA(355.3,IBCPOL,0)),U),IBCPOL) G IAQ
33 N I,J,IBXX,VALMY,IBCDFN
34 D EN^VALM2($G(XQORNOD(0)))
35 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
36 .N IBCPOL,IBCPND,IBCPND1
37 .S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
38 .Q:IBCPOL=""
39 .D FULL^VALM1
40 .S IBCPND=$G(^IBA(355.3,IBCPOL,0))
41 .I '$P(IBCPND,U,2) W !,"You cannot inactivate an individual plan." D PAUSE^VALM1 Q
42 .K IBCDFN
43 .D INACT^IBCNSJ1(+$P($G(^IBA(355.3,IBCPOL,0)),U),IBCPOL),PAUSE^VALM1
44 .S IBCPND1=$G(^IBA(355.3,IBCPOL,0))
45 .I $P(IBCPND1,U,11)'=$P(IBCPND,U,11)!(IBCPND1="") D
46 ..D INIT^IBCNSU2 ;Rebuild list if plan changed or deleted
47 ..N IBCPOLD S IBCPOLD=$G(^IBA(355.3,+$G(IBCPOL),0))
48 ..I IBCPOLD'="" D HDR^IBCNSC41
49IAQ I $G(IBCPOL) D ;Rebuild header
50 .N IBCPOLD S IBCPOLD=$G(^IBA(355.3,+$G(IBCPOL),0))
51 .I IBCPOLD'="" D HDR^IBCNSC41
52 S VALMBCK="R"
53 Q
54 ;
55VP ; -- Edit/View Plan
56 D FULL^VALM1
57 N IBCND1,IBCDFND,IBCPOL,IBCPOLD,IBXX,VALMY,IBCDFN
58 D EN^VALM2($G(XQORNOD(0)))
59 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
60 .S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
61 .Q:IBCPOL=""
62 .D FULL^VALM1
63 .K IBCDFN
64 .D EN^VALM("IBCNS INS CO PLAN DETAIL")
65 .Q
66 I '$D(IBFASTXT) D INIT^IBCNSU2
67 S VALMBCK="R"
68 Q
69 ;
70PC ; Plan comments
71 W !!,"You may now enter comments about this plan."
72 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PCQ
73 S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE
74 D INIT^IBCNSC4
75 L -^IBA(355.3,+IBCPOL)
76PCQ S VALMBCK="R" Q
77 ;
78CP ;Change insurance plans
79 D FULL^VALM1
80 S DIR(0)="Y",DIR("A")="Do you want to see the list of plans for this insurance company"
81 S DIR("?")="Enter 'YES' if you want to use the LIST MANAGER lookup facility on the previous screen to select a plan. Enter 'NO' to select a plan using the standard Fileman lookup."
82 S VALMBCK="R"
83 D ^DIR K DIR I $D(DIRUT) G CPEX
84 I Y S VALMBCK="Q" G CPEX
85 S DIC("S")="I $P(^(0),U)=$G(IBCNS)",DIC="^IBA(355.3,",DIC(0)="AEMQ"
86 S DIC("W")="N IBX S IBX=$G(^(0)) W "" Name: "",$E($S($P(IBX,U,3)'="""":$P(IBX,U,3),1:""<none>"")_$J("""",20),1,20),"" Number: "",$S($P(IBX,U,4)'="""":$P(IBX,U,4),1:""<none>"")"
87 S DIC("W")=DIC("W")_","" "",$S($P(IBX,U,2):""GROUP"",1:""INDIVIDUAL""),"" "",$S($P(IBX,U,11):""IN"",1:""""),""ACTIVE"""
88 S DIC("A")="Select "_$P($G(^DIC(36,+$G(IBCNS),0)),U)_" PLAN: "
89 D ^DIC K DIC
90 G:Y<0 CPEX S IBCPOL=+Y
91 D INIT^IBCNSC4
92CPEX Q
93 ;
94CV ;Edit coverage limitations from edit patient policy
95 D EDCOV^IBCNSJ51
96 D BLD^IBCNSP
97 Q
98CV1 ;Edit coverage limitations from edit plan
99 D EDCOV^IBCNSJ51
100 D INIT^IBCNSC4
101 Q
102 ;
Note: See TracBrowser for help on using the repository browser.