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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1IBCNSC02 ;ALB/ESG - Insurance Company parent/child management ;01-NOV-2005
2 ;;2.0;INTEGRATED BILLING;**320,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7DISP ; entry point for display of parent/child companies
8 NEW PCFLG,PARENT,PCDESC,TITLE,START,IBLINE,OFFSET,INSDATA,CNT,TXT
9 S PCFLG=$P($G(^DIC(36,+IBCNS,3)),U,13),PARENT=""
10 I PCFLG="C" S PARENT=$P($G(^DIC(36,+IBCNS,3)),U,14),PCDESC="Child"
11 I PCFLG="P" S PCDESC="Parent"
12 S TITLE=" Associated Insurance Companies "
13 S (START,IBLINE)=62
14 S OFFSET=(40-($L(TITLE)/2))\1+1
15 D SET^IBCNSP(START,OFFSET,TITLE,IORVON,IORVOFF)
16 ;
17 ; no link - display this and get out
18 I PCFLG="" D G DISPX
19 . S IBLINE=IBLINE+1
20 . D SET^IBCNSP(IBLINE,3,"This insurance company is not defined as either a Parent or a Child.")
21 . Q
22 ;
23 ; display for either parent or child
24 S IBLINE=IBLINE+1
25 D SET^IBCNSP(IBLINE,3,"This insurance company is defined as a "_PCDESC_" Insurance Company.")
26 ;
27 ; child display
28 I PCFLG="C" D G DISPX
29 . S IBLINE=IBLINE+1
30 . D SET^IBCNSP(IBLINE,3,"It is associated with the following Parent Insurance Company:")
31 . S IBLINE=IBLINE+1
32 . D SET^IBCNSP(IBLINE,2," ") ; blank line
33 . S INSDATA=""
34 . I 'PARENT S INSDATA="*** Parent Insurance Company not defined ***"
35 . I PARENT D
36 .. N AD S AD=$$INSADD(PARENT) ; get parent ins co data
37 .. S INSDATA=$P(AD,U,1)_" "_$P(AD,U,2)_" "_$P(AD,U,6)
38 .. Q
39 . S IBLINE=IBLINE+1
40 . D SET^IBCNSP(IBLINE,8,INSDATA)
41 . Q
42 ;
43 ; parent display
44 S CNT=$$PCNT(IBCNS) ; count # of children
45 S TXT="There are "_CNT_" Child Insurance Companies"
46 I CNT=1 S TXT="There is 1 Child Insurance Company"
47 S TXT=TXT_" associated with it."
48 S IBLINE=IBLINE+1
49 D SET^IBCNSP(IBLINE,3,TXT)
50 S IBLINE=IBLINE+1
51 D SET^IBCNSP(IBLINE,3,"Select the ""AC Associate Companies"" action to enter/edit the children.")
52 ;
53DISPX ; end with 2 blank lines
54 S IBLINE=IBLINE+1
55 D SET^IBCNSP(IBLINE,2," ") ; blank line
56 S IBLINE=IBLINE+1
57 D SET^IBCNSP(IBLINE,2," ") ; blank line
58 Q
59 ;
60PARENT(IBCNS) ; Insurance company parent/child management
61 ; Calls ListMan screen for parent insurance companies
62 NEW PCFLG
63 I '$G(IBCNS) G PARENTX
64 S PCFLG=$P($G(^DIC(36,IBCNS,3)),U,13)
65 ;
66 ; special check to remove 3.13 field if 3.14 field is nil
67 I PCFLG="C",'$P($G(^DIC(36,IBCNS,3)),U,14) D
68 . N DIE,DA,DR S DIE=36,DA=IBCNS,DR="3.13////@" D ^DIE
69 . Q
70 ;
71 ; get out if not a parent insurance company
72 I PCFLG'="P" G PARENTX
73 ;
74 ; call ListMan for parent/children management
75 D EN^VALM("IBCNS ASSOCIATIONS LIST")
76 KILL ^TMP($J,"IBCNSL")
77PARENTX ;
78 Q
79 ;
80HDR ; List header info
81 S VALMHDR(1)="Parent Insurance Company:"
82 S VALMHDR(2)=" "_$$INSCO(IBCNS)
83 S VALMHDR(3)=""
84HDRX ;
85 Q
86 ;
87BLD ; Build list contents
88 NEW C,INSDATA,INSNAME,STCITY,ENTRY,NM,ST,IEN,X
89 KILL ^TMP($J,"IBCNSL")
90 S C=0
91 F S C=$O(^DIC(36,"APC",IBCNS,C)) Q:'C D
92 . S INSDATA=$$INSADD(C)
93 . S INSNAME=$P(INSDATA,U,1)
94 . I INSNAME="" S INSNAME="~UNKNOWN"
95 . S STCITY=$P(INSDATA,U,7)
96 . I STCITY="" S STCITY="~UNKNOWN"
97 . S ^TMP($J,"IBCNSL",1,INSNAME,STCITY,C)=""
98 . Q
99 ;
100 I '$D(^TMP($J,"IBCNSL",1)) D G BLDX
101 . ; no children insurance companies found
102 . S ^TMP($J,"IBCNSL",2,1,0)=""
103 . S ^TMP($J,"IBCNSL",2,2,0)=" No Children Insurance Companies Found"
104 . S VALMCNT=2
105 . Q
106 ;
107 S VALMCNT=0,ENTRY=0
108 S NM=""
109 F S NM=$O(^TMP($J,"IBCNSL",1,NM)) Q:NM="" D
110 . S ST=""
111 . F S ST=$O(^TMP($J,"IBCNSL",1,NM,ST)) Q:ST="" D
112 .. S IEN=0
113 .. F S IEN=$O(^TMP($J,"IBCNSL",1,NM,ST,IEN)) Q:'IEN D
114 ... S VALMCNT=VALMCNT+1,ENTRY=ENTRY+1
115 ... S X=$$FO^IBCNEUT1($J(ENTRY,3),5)_$$INSCO(IEN)
116 ... S ^TMP($J,"IBCNSL",2,VALMCNT,0)=X
117 ... S ^TMP($J,"IBCNSL",2,"IDX",VALMCNT,ENTRY)=""
118 ... S ^TMP($J,"IBCNSL",3,ENTRY)=IEN_U_VALMCNT
119 ... Q
120 .. Q
121 . Q
122BLDX ;
123 Q
124 ;
125LINK ; action protocol IBCNSL LINK used to associate children insurance
126 ; companies to the current parent ins co for the list
127 NEW DIC,X,Y,DIE,DR,DA,NEWINS,IBSTOP,PAR,DIR,DIRUT,DTOUT,DUOUT,DIROUT
128 D FULL^VALM1
129 I '$$KCHK^XUSRB("IB EDI INSURANCE EDIT") D G LINKX
130 . W !!?5,"You must hold the IB EDI INSURANCE EDIT key to access this option."
131 . D PAUSE^VALM1
132 . Q
133 ;
134 ; lookup ins company
135 W !
136 S DIC=36,DIC(0)="AEMQ",DIC("A")="Select Insurance Company: "
137 S DIC("W")="D INSLIST^IBCNSC02(Y)"
138 ; screen - ins co Y is not a parent and also it is not already in the list of children
139 S DIC("S")="I $P($G(^DIC(36,Y,3)),U,13)'=""P""&'$D(^DIC(36,""APC"",IBCNS,Y))"
140 D ^DIC K DIC
141 I +Y'>0 G LINKX
142 S NEWINS=+Y
143 ;
144 ; check to see if this selected insurance company is already a child
145 ; for some other parent
146 S PAR=+$P($G(^DIC(36,NEWINS,3)),U,14),IBSTOP=0
147 I PAR,PAR'=IBCNS D
148 . W !
149 . S DIR(0)="YO",DIR("B")="No"
150 . S DIR("A",1)="Please Note: The insurance company you selected is currently identified"
151 . S DIR("A",2)="as a Child insurance company associated with the following Parent:"
152 . S DIR("A",3)=""
153 . S DIR("A",4)=" "_$$INSCO(PAR)
154 . S DIR("A",5)=""
155 . S DIR("A")="OK to proceed and make this switch"
156 . D ^DIR K DIR
157 . I Y'=1 S IBSTOP=1 Q
158 . Q
159 I IBSTOP G LINKX
160 ;
161 ; lock the potential new child ins company
162 L +^DIC(36,NEWINS):0 I '$T D LOCKED^IBTRCD1 G LINKX
163 ;
164 ; update selected child
165 S DIE=36,DA=NEWINS,DR="3.13////C;3.14////"_IBCNS D ^DIE
166 ;
167 ; Copy the IDs from the parent
168 D COPY^IBCEPCID(NEWINS)
169 ;
170 ; unlock
171 L -^DIC(36,NEWINS)
172 ;
173 D BLD ; rebuild list of children
174LINKX ;
175 S VALMBCK="R"
176 Q
177 ;
178UNLINK ; action protocol IBCNSL UNLINK used to disassociate selected children
179 ; insurance companies from the list.
180 NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBLST,IBSUB,IBPCE,IBSEL,DA,DIE,DR
181 D FULL^VALM1
182 I '$$KCHK^XUSRB("IB EDI INSURANCE EDIT") D G UNLINKX
183 . W !!?5,"You must hold the IB EDI INSURANCE EDIT key to access this option."
184 . D PAUSE^VALM1
185 . Q
186 ;
187 I '$D(^TMP($J,"IBCNSL",3)) D G UNLINKX
188 . W !!?5,"There are no insurance companies to select." D PAUSE^VALM1
189 . Q
190 S DIR(0)="LO^1:"_+$O(^TMP($J,"IBCNSL",3,""),-1)
191 S DIR("A")="Select Insurance Company(s)"
192 W ! D ^DIR K DIR
193 I $D(DIRUT) G UNLINKX
194 M IBLST=Y
195 ;
196 W !
197 S DIR(0)="YO"
198 S DIR("A")="OK to proceed",DIR("B")="No"
199 D ^DIR K DIR
200 I Y'=1 G UNLINKX
201 ;
202 F IBSUB=0:1 Q:'$D(IBLST(IBSUB)) F IBPCE=1:1 S IBSEL=$P(IBLST(IBSUB),",",IBPCE) Q:'IBSEL D
203 . S DA=+$G(^TMP($J,"IBCNSL",3,IBSEL)) I 'DA Q
204 . S DIE=36,DR="3.13////@;3.14////@" D ^DIE
205 . Q
206 ;
207 D BLD ; rebuild list of children
208UNLINKX ;
209 S VALMBCK="R"
210 Q
211 ;
212PCNT(Z) ; count number of children for parent ins co Z
213 NEW C,CNT
214 S C=0,Z=+$G(Z)
215 F CNT=0:1 S C=$O(^DIC(36,"APC",Z,C)) Q:'C
216 Q CNT
217 ;
218INSADD(Z) ; function to return ins co address components
219 NEW INSDATA,AD,NM,L1,CITY,ST,ZIP,CITYST,STCITY
220 S INSDATA=""
221 S AD=$G(^DIC(36,+$G(Z),.11))
222 S NM=$P($G(^DIC(36,Z,0)),U,1)
223 S L1=$P(AD,U,1),CITY=$P(AD,U,4),ST=$P(AD,U,5),ZIP=$P(AD,U,6)
224 I ST S ST=$P($G(^DIC(5,ST,0)),U,2)
225 S CITYST=$E(CITY,1,15)_" "_ST
226 I CITY'="",ST'="" S CITYST=$E(CITY,1,15)_","_ST
227 ;
228 S $P(STCITY,"|",1)=ST
229 I ST="" S $P(STCITY,"|",1)="~~"
230 S $P(STCITY,"|",2)=CITY
231 I CITY="" S $P(STCITY,"|",2)="~~~~"
232 ;
233 S INSDATA=NM_U_L1_U_CITY_U_ST_U_ZIP_U_CITYST_U_STCITY
234 ; 1 2 3 4 5 6 7
235INSADDX ;
236 Q INSDATA
237 ;
238INSCO(Z) ; return display data for ins co Z
239 NEW X,Y
240 S Y=$$INSADD(Z)
241 S X=$$FO^IBCNEUT1($P(Y,U,1),27)
242 S X=X_$$FO^IBCNEUT1($P(Y,U,2),26)
243 S X=X_$$FO^IBCNEUT1($P(Y,U,6),18)
244INSCOX ;
245 Q X
246 ;
247INSLIST(INS) ; insurance company lister for ^DIC call
248 NEW Z
249 S Z=$$INSADD(INS)
250 W ?27,$E($P(Z,U,2),1,20) ; address line 1
251 W ?47," ",$P(Z,U,6) ; city, state
252INSLISTX ;
253 Q
254 ;
Note: See TracBrowser for help on using the repository browser.