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

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

revised back to 6/30/08 version
File size: 8.0 KB
Line 
1IBCNBEE ;ALB/ARH-Ins Buffer: add/edit existing entries in buffer ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,184,252,251,356,361**;21-MAR-94;Build 9
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5ADD(IBSOURCE) ; add a new buffer file entry (#355.33), sets only status (0) node data
6 N IBARR,IBERR,IBIFN,IBX I '$G(IBSOURCE) S IBSOURCE=1
7 ;
8 S IBARR(355.33,"+1,",.01)="NOW",IBARR(355.33,"+1,",.03)=IBSOURCE
9 D UPDATE^DIE("E","IBARR","IBIFN","IBERR")
10 S IBX=+$G(IBIFN(1)) I $D(IBERR) S $P(IBX,U,2)=$G(IBERR("DIERR",1,"TEXT",1))
11 Q IBX
12 ;
13STATUS(IBBUFDA,STATUS,NC,NG,NP) ; edit the status node
14 ;
15 N IBX,IBARR,IBIFN Q:'$G(IBBUFDA) S IBIFN=IBBUFDA_","
16 D CHK^DIE(355.33,.04,"",$G(STATUS),.IBX) Q:IBX="^"
17 ;
18 S IBARR(355.33,IBIFN,.04)=STATUS I STATUS="R" S (NC,NG,NP)=0
19 S IBARR(355.33,IBIFN,.07)=+$G(NC),IBARR(355.33,IBIFN,.08)=+$G(NG),IBARR(355.33,IBIFN,.09)=+$G(NP)
20 D FILE^DIE("E","IBARR")
21 Q
22 ;
23INS(IBBUFDA,FLDS) ; edit the insurance company portion of a buffer file entry
24 ;
25 N DIC,DIE,DA,DR,X,Y,IBCNEXT1
26 I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q
27 I $G(FLDS)="" S FLDS="MR"
28 ;
29 ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing
30 ; - the insurance company name in the buffer. Also added an
31 ; - input transform (see below) to clean up the data coming in.
32 ; - fetch the current buffer ins co name
33 ;
34 I FLDS="MR" S IBCNEXT1=$P($G(^IBA(355.33,IBBUFDA,20)),U,1)
35 ;
36 S DR=$P($T(@(FLDS_"INS")+1),";;",2,9999) Q:DR=""
37 ;
38 I FLDS="MR" Q:$$INSNAME(IBBUFDA)<0 S DR=$P($T(@(FLDS_"INS")+1),";;",2,9999),DR=$P(DR,";",2,99999)
39 ;
40 S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
41 Q
42 ;
43GRP(IBBUFDA,FLDS) ; edit the group/plan portion of the buffer file entry
44 ;
45 N DIC,DIE,DA,DR,X,Y I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q
46 I $G(FLDS)="" S FLDS="MR"
47 ;
48 S DR=$P($T(@(FLDS_"GRP")+1),";;",2,9999) Q:DR=""
49 S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
50 Q
51 ;
52POLICY(IBBUFDA,FLDS) ; edit the patient policy portion of the buffer file entry
53 ;
54 N DIC,DIE,DA,DR,X,Y,IBZZ I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q
55 I $G(FLDS)="" S FLDS="MR"
56 ;
57 S DR=$P($T(@(FLDS_"POL")+1),";;",2,9999) Q:DR=""
58 S DIE="^IBA(355.33,",DA=IBBUFDA
59 S DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DA,DR Q:$D(Y)
60 ;
61 I FLDS="MR" D ESGHP(IBBUFDA)
62 Q
63 ;
64ESGHP(IBBUFDA) ; sponsoring employer information
65 N DIR,DIRUT,DUOUT,DTOUT,VAOA,VAERR,VA,DFN,IB60,IBE,IBEMPST,IBREL
66 ;
67 ; if insured is patient or spouse, ask if insured's current employer is the plan's sponsoring employer, if yes auto stuff it
68 I +$G(^IBA(355.33,IBBUFDA,61)) W ! S IB60=$G(^IBA(355.33,IBBUFDA,60)) D Q:$D(DIRUT)
69 . ; sponsoring employer is current employer?
70 . S DFN=+IB60,IBREL=$P(IB60,U,6),VAOA("A")=$S(IBREL="01":5,IBREL="02":6,1:"") I 'DFN!(VAOA("A")="") Q
71 . D OAD^VADPT I $G(VAOA(9))="" Q
72 . S DIR("?")="Enter Yes if this plan is sponsored by the "_$S(IBREL="01":"patient's",1:"spouse's")_" current employer."
73 . S DIR("?",1)="Entering Yes will result in the "_$S(IBREL="01":"patient's",1:"spouse's")_" current employer data being",DIR("?",2)="added to the policy as the Sponsoring Employer data.",DIR("?",3)=""
74 . S DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan",DIR("B")="No",DIR(0)="Y" D ^DIR W ! I Y'=1 Q
75 . ;
76 . D DELEMP(IBBUFDA) ; delete any data already contained in these fields
77 . ;
78 . ; if the insured's current employer sponsors the plan then stuff that employer's address into the buffer
79 . S IBE=$S(IBREL="01":.311,1:.25),IBEMPST=$P($G(^DPT(DFN,IBE)),U,15)
80 . S DR="61.02///"_VAOA(9)_";61.03///"_IBEMPST_";61.06///"_$E(VAOA(1),1,30)_";61.07///"_$E(VAOA(2),1,30)
81 . S DR=DR_";61.08///"_$E(VAOA(3),1,30)_";61.09///"_$E(VAOA(4),1,20)_";61.1////"_$P(VAOA(5),U,1)
82 . S DR=DR_";61.11////"_$P(VAOA(11),U,1)_";61.12///"_$E(VAOA(8),1,15)
83 . S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
84 ;
85 ; if employer sponsored plan, edit buffer entry's sponsoring employer info
86 I +$G(^IBA(355.33,IBBUFDA,61)) S DR="61.02:61.12",DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
87 ;
88 ; if not employer sponsored plan, delete any existing sponsoring employer data
89 I $D(^IBA(355.33,IBBUFDA,61)),'$G(^IBA(355.33,IBBUFDA,61)) D DELEMP(IBBUFDA)
90 Q
91 ;
92DELEMP(IBBUFDA) ; delete sponsoring employer data
93 N DIC,DIE,DA,DR,X,Y Q:'$D(^IBA(355.33,+$G(IBBUFDA),61))
94 S DR="61.02///@;61.03///@;61.04///@;61.05///@;61.06///@;61.07///@;61.08///@;61.09///@;61.10///@;61.11///@;61.12///@"
95 S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
96 Q
97 ;
98INSHELP ;
99 W !!,"------------------------ INSURANCE COMPANY INFORMATION -------------------------",!
100 Q
101GRPHELP ;
102 W !!,"---------------------------- GROUP/PLAN INFORMATION ----------------------------"
103 W !," The following data defines a specific Group or Plan provided by an Insurance "
104 W !," Company. This may be either a group plan with many potential members or an "
105 W !," individual plan with a single member.",!
106 Q
107POLHELP ;
108 W !!,"---------------------- POLICY AND SUBSCRIBER INFORMATION -----------------------"
109 W !," The following data defines the subscriber specific policy information for a "
110 W !," particular Insurance Plan. The subscriber, the insured, and the policy holder "
111 W !," all refer to the person who is a member of the plan and therefore holds the "
112 W !," policy. The patient must be covered under the plan but may not be the policy"
113 W !," holder.",!
114 Q
115 ;
116INSNAME(IBBUFDA) ; Reset insurance company name
117 N DR,DIE,DA,Y,X,IBX,IBNEW,IBNAME
118 S IBX=-1
119 S DR=20.01,DIE="^IBA(355.33,",DA=IBBUFDA
120 D ^DIE
121 I '$D(Y) S IBNEW=$$CHECK(IBBUFDA)
122 I +$G(IBNEW)'<0,$G(IBNEW)'=0,$D(IBNEW) S DR=$P(DR,";",1)_"////"_IBNEW S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR I '$D(Y) S IBX=0
123 ; BHS - 10/15/03 - If user entered a caret during $$CHECK still set
124 ; return value to 0 so the user can edit the other
125 ; INS fields
126 I $G(IBNEW)=0!($G(IBNEW)=-1) S IBX=0
127 Q IBX
128 ;
129CHECK(IBBUFDA) ; Select Insurance Company Name and Automatch
130 ; Buffer file (#355.33), field# 20.01.
131 ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing the
132 ; insurance company name. Also, display the insurance company
133 ; name lookup/lister and the Auto Match lookup/lister.
134 ;
135 NEW IBNEW,IBNAME,AMLIST
136 ;
137 S IBNEW=0,IBNAME=$P($G(^IBA(355.33,$G(IBBUFDA),20)),U,1)
138 I IBNAME="" G CHECKQ
139 ;
140 ; Perform an insurance company lookup/lister
141 ; BHS - 10/15/03 - Removed quits when user enters a caret to quit the
142 ; the ins lister or Auto Match lister
143 S IBNEW=$$DICINS^IBCNBU1(IBNAME,1,10)
144 I IBNEW=0!(IBNEW<0) D
145 . I '$$AMLOOK^IBCNEUT1(IBNAME,1,.AMLIST) Q
146 . S IBNEW=$$AMSEL^IBCNEUT1(.AMLIST)
147 ;
148 ; user chose a valid insurance company - possible Auto Match add
149 I IBNEW'<0,IBNEW'=0 D AMADD^IBCNEUT6(X,IBCNEXT1)
150 ;
151CHECKQ Q IBNEW
152 ;
153MRINS ; Insurance Company fields asked of MCCR users in the Buffer Process options (all buffer ins fields 20.01-21.06)
154 ;;20.01;20.05;20.02:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06
155 ;
156MRGRP ; Group/Plan fields asked of MCCR users in the Buffer Process options (all buffer grp fields 40.01-40.09) ;;Daou/EEN adding BIN and PCN (40.1,40.11)
157 ;;40.01:40.03;40.1;40.11;40.09;40.04:40.08
158 ;
159MRPOL ; Patient Policy fields asked of MCCR users in the Buffer Process options (all buffer policy fields except ESGHP 60.02-61.01
160 ;;60.02;60.03;60.05;60.06//^S X=$S(X="v":"01",X="s":"02",1:"");S IBZZ=X;60.04;I IBZZ'="01" S Y="@111";60.07///1;60.08///@;60.09///@;S Y="@112";@111;60.07:60.09;60.13;@112;60.1:60.12;.03;61.01
161 ;
162OTINS ; Insurance Company fields asked of non-MCCR users entering buffer data from options outside IB (20.01-20.04,21.01-21.06)
163 ;;20.01:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06
164 ;
165OTGRP ; Group/Plan fields asked of non-MCCR users entering buffer data from options outside IB (40.02,40.03,40.09) ;;Daou/EEN-adding BIN & PCN (40.1,40.11)
166 ;;40.02;40.03;40.1;40.11;40.09
167 ;
168OTPOL ; Patient Policy fields asked of non-MCCR users entering buffer data from options outside IB (60.02-60.09)
169 ;;60.02;60.03;60.05;60.06//^S X=$S(X="v":"01",X="s":"02",1:"");S IBZZ=X;60.04;I IBZZ'="01" S Y="@111";60.07///1;60.08///@;60.09///@;S Y="@112";@111;60.07:60.09;60.13;@112
Note: See TracBrowser for help on using the repository browser.