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

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

revised back to 6/30/08 version

File size: 5.9 KB
Line 
1IBCNSP3 ;ALB/AAS - INSURANCE MANAGEMENT EDIT ; 06-JUL-93
2 ;;2.0;INTEGRATED BILLING;**28,52,85,251**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G ^IBCNSM4
6 ;
7SAVEPT(DFN,DA) ; -- Save the global before editing
8 K ^TMP($J,"IBCNSPT")
9 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,0)=$G(^DPT(DFN,.312,+DA,0))
10 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,1)=$G(^DPT(DFN,.312,+DA,1))
11 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,2)=$G(^DPT(DFN,.312,+DA,2))
12 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,3)=$G(^DPT(DFN,.312,+DA,3))
13 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,4)=$G(^DPT(DFN,.312,+DA,4))
14 Q
15 ;
16COMPPT(DFN,DA) ; -- Compare before editing with globals
17 S IBDIF=0
18 I $G(^DPT(DFN,.312,+DA,0))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,0)) S IBDIF=1 G COMPPTQ
19 I $G(^DPT(DFN,.312,+DA,1))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,1)) S IBDIF=1 G COMPPTQ
20 I $G(^DPT(DFN,.312,+DA,2))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,2)) S IBDIF=1 G COMPPTQ
21 I $G(^DPT(DFN,.312,+DA,3))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,3)) S IBDIF=1 G COMPPTQ
22 I $G(^DPT(DFN,.312,+DA,4))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,4)) S IBDIF=1 G COMPPTQ
23 ;
24COMPPTQ I IBDIF D:'$D(IBCOVP) COVERED^IBCNSM31(DFN,$P($G(^DPT(DFN,.31)),"^",11))
25 Q
26 ;
27UPDATPT(DFN,DA) ; -- enter date and user if editing has taken place
28 N DR,DIE,DIC
29 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
30 S DR="1.05///NOW;1.06////"_DUZ
31 D ^DIE
32 Q
33 ;
34EM ; -- Employer for claims update
35 D FULL^VALM1 W !!
36 N IBDIF,DA,DR,DIC,DIE
37 D SAVEPT(DFN,IBCDFN)
38 D VARS
39 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EMQ
40 ;
41 ;S DR="2.01;S:'$P($G(^DPT(DFN,.312,+$G(DA),2)),U) Y=""@999"";W !!,""*** If ROI applies, make sure current consent is signed! ***"",!;2.015;2.02;2.03;2.04;2.05;2.06;2.07;2.08;2.09;@999"
42 ;
43 S DR="2.1" D ^DIE K DIE,DR
44 ;
45 I +$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10),$P($G(^DPT(DFN,.312,+$G(DA),2)),U,9)="" D EMPSET(DFN,$G(DA)) ; curr emp
46 ;
47 I +$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10) D VARS S DR="2.015;2.11;2.12;2.01;W:+X !!,""*** If ROI applies, make sure current consent is signed! ***"",!!;2.02;2.03;2.04;2.05;2.06;2.07;2.08;@999" D ^DIE K DIE,DR
48 ;
49 ;I '$P($G(^DPT(DFN,.312,+$G(DA),2)),U) D VARS S DR="2.015///@;2.02///@;2.03///@;2.04///@;2.05///@;2.06///@;2.07///@;2.08///@" D ^DIE
50 ;
51 I '$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10) D VARS S DR="2.01///@;2.015///@;2.02///@;2.03///@;2.04///@;2.05///@;2.06///@;2.07///@;2.08///@;2.11///@;2.12///@" D ^DIE
52 ;
53 D COMPPT(DFN,IBCDFN)
54 I IBDIF D UPDATPT(DFN,IBCDFN),BLD^IBCNSP
55 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
56EMQ S VALMBCK="R" Q
57 ;
58AC ; -- Add Comment
59 D FULL^VALM1 W !!
60 N IBDIF,DA,DR,DIE,DIC,X,Y
61 D SAVEPT(DFN,IBCDFN)
62 W !!,"You may now enter a brief comment about this patient's policy"
63 D VARS
64 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G ACQ
65 S DR="1.08" D ^DIE
66 D COMPPT(DFN,IBCDFN) I IBDIF D UPDATPT(DFN,IBCDFN)
67 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
68 W !!,"You may now enter comments about this Group Plan that pertains to all Patients"
69 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ACQ
70 S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE
71 D BLD^IBCNSP
72 L -^IBA(355.3,+IBCPOL)
73ACQ S VALMBCK="R" Q
74 ;
75BLS(X,Y) ; -- blank a section of lines
76 N I
77 F I=X:1:Y D BLANK^IBCNSP(.I)
78 Q
79 ;
80VARS ; -- set vars for call to die for .312 node
81 S DA(1)=DFN,DA=$P(IBPPOL,"^",4)
82 S DIE="^DPT("_DA(1)_",.312,"
83 Q
84 ;
85SAVE(IBCPOL) ; -- Save the global before editing
86 K ^TMP($J,"IBCNSP")
87 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,0)=$G(^IBA(355.3,+IBCPOL,0))
88 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,1)=$G(^IBA(355.3,+IBCPOL,1))
89 ;;Daou/EEN - adding BIN and PCN
90 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,6)=$G(^IBA(355.3,+IBCPOL,6))
91 Q
92 ;
93COMP(IBCPOL) ; -- Compare before editing with globals
94 S IBDIF=0
95 I $G(^IBA(355.3,+IBCPOL,0))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,0)) S IBDIF=1 Q
96 I $G(^IBA(355.3,+IBCPOL,1))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,1)) S IBDIF=1 Q
97 ;;Daou/EEN - adding BIN and PCN
98 I $G(^IBA(355.3,+IBCPOL,6))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,6)) S IBDIF=1 Q
99 Q
100 ;
101UPDATE(IBCPOL) ; -- Update last edited by
102 N DA,DIC,DIE,DR
103 S DIE="^IBA(355.3,",DA=IBCPOL,DR="1.05///NOW;1.06////"_DUZ
104 D ^DIE
105 Q
106 ;
107RIDERS ; -- add/edit personal riders
108 ;
109 D FULL^VALM1
110 N IBDIF,DA,DR,DIE,DIC,X,Y,IBCDFN,IBPRD,IBPRY
111 S IBCDFN=$P(IBPPOL,"^",4)
112 W ! D DISPR W !
113 ;
114R1 S DIC="^IBA(355.7,",DIC(0)="AEQML",DLAYGO=355.7
115 S DIC("DR")=".02////"_DFN_";.03////"_IBCDFN
116 S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,3)=IBCDFN"
117 I $D(IBPRD) S DIC("B")=IBPRD
118 D ^DIC K DIC,IBPRD
119 I +Y<1 G RIDERQ
120 S IBPRY=+Y
121 L +^IBA(355.7,IBPRY):5 I '$T D LOCKED^IBTRCD1 G RIDERQ
122 S DIE="^IBA(355.7,",DA=+Y,DR=".01",DIDEL=355.7
123 D ^DIE K DA,DR,DIE,DIC,DIDEL
124 L -^IBA(355.7,IBPRY)
125 W ! G R1
126RIDERQ S VALMBCK="R"
127 Q
128 ;
129RD ; -- Add riders/ for multiple policies
130 D FULL^VALM1
131 N I,J,IBXX,VALMY
132 D EN^VALM2($G(XQORNOD(0)))
133 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
134 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
135 .Q:IBPPOL=""
136 .D RIDERS
137 .Q
138 D BLD^IBCNSM
139 S VALMBCK="R"
140 Q
141 ;
142DISPR ; -- Display riders
143 N IBPR,I,J
144 S I=0
145 I '$G(IBCDFN)!('$G(DFN)) G DISPRQ
146 W !,"Current Personal Riders: "
147 F S I=$O(^IBA(355.7,"APP",DFN,IBCDFN,I)) Q:'I S J=$O(^(I,0)),IBPR=$G(^IBA(355.7,+J,0)) D
148 .S IBPRD=$$EXPAND^IBTRE(355.7,.01,+IBPR)
149 .W !?5,IBPRD
150 I '$D(IBPRD) W !?5,"None Indicated"
151DISPRQ Q
152 ;
153EMPSET(DFN,IBCPOL) ; insert patient or spouses current employer as ESGHP address if that employer sponsors this plan
154 N IBWHOS,VAOA,DIR,IBE,IBEMPST,DR,X,Y
155 I +$G(DFN) S IBWHOS=$P($G(^DPT(DFN,.312,+$G(IBCPOL),0)),U,6) S VAOA("A")=$S(IBWHOS="v":5,IBWHOS="s":6,1:"")
156 I $G(VAOA("A"))'="" D OAD^VADPT I $G(VAOA(9))'="" D
157 . ;
158 . S DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan",DIR("B")="No",DIR(0)="Y" W ! D ^DIR W ! Q:'Y W "...."
159 . D VARS S IBE=$S(IBWHOS="v":.311,1:.25),IBEMPST=$P($G(^DPT(DFN,IBE)),U,15)
160 . ;
161 . S DR="2.015///"_VAOA(9)_";2.02///"_VAOA(1)_";2.03///"_VAOA(2)_";2.04///"_VAOA(3)_";2.05///"_VAOA(4) D ^DIE
162 . S DR="2.06////"_$P(VAOA(5),U,1)_";2.07////"_$P(VAOA(11),U,1)_";2.08///"_$E(VAOA(8),1,15)_";2.11////"_IBEMPST D ^DIE
163 Q
Note: See TracBrowser for help on using the repository browser.