close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP7.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 6.8 KB
RevLine 
1IBCEP7 ;ALB/TMP - Functions for fac level PROVIDER ID MAINT ;11-07-00
2 ;;2.0;INTEGRATED BILLING;**137,232,320,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5HDR ; -- hdr code
6 I '$D(^TMP("IBCE_PRVFAC_MAINT",$J)) D INIT
7 N IBINS,PCF,PCDISP,IBPARAM,IBEFTFL
8 K VALMHDR
9 S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
10 S IBEFTFL=$P(IBPARAM,U) ; Electronic Form type flag
11 S IBINS=+$P(IBPARAM,U,2) ; Insurance co
12 S PCF=$P($G(^DIC(36,+IBINS,3)),U,13),PCDISP=$S(PCF="P":"(Parent)",1:"")
13 S VALMHDR(1)="Insurance Co: "_$P($G(^DIC(36,+IBINS,0)),U)_PCDISP
14 S VALMHDR(1)=VALMHDR(1)_$S(IBEFTFL="E":" Billing Provider Secondary IDs",IBEFTFL="A":" Additional Billing Provider Sec. IDs",IBEFTFL="LF":" VA-Lab/Facility Secondary IDs",1:"")
15 I IBEFTFL="LF" S VALMHDR(2)="VA-Lab/Facility Primary ID: Federal Tax ID"
16 Q
17 ;
18INIT ; Initialize
19 N IBCT,IBD,Z,Z0,Z00,Z1,IBS,IBX,IBDIV,IBEFTFL,IBINS,IBPARAM,IBLCT,IBCU
20 K ^TMP("IBCE_PRVFAC_MAINT",$J)
21 S (IBLCT,IBCT)=0
22 S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
23 S IBEFTFL=$P(IBPARAM,U) ; Electronic Form type flag
24 S IBINS=+$P(IBPARAM,U,2) ; Insurance co
25 ;
26 I IBEFTFL="A" D
27 . K VALM("PROTOCOL")
28 . S Y=$$FIND1^DIC(101,,,"IBCE PRVFAC ADDIDS MAINT")
29 . I Y S VALM("PROTOCOL")=+Y_";ORD(101,"
30 ;
31 I IBEFTFL="LF" D
32 . S VALM("TITLE")="VA-Lab/Facility IDs"
33 . K VALM("PROTOCOL")
34 . S Y=$$FIND1^DIC(101,,,"IBCE PRVFAC VALF MAINT")
35 . I Y S VALM("PROTOCOL")=+Y_";ORD(101,"
36 ;
37 ; Compile the appropriate list of IDs
38 S Z=0 F S Z=$O(^IBA(355.92,"B",IBINS,Z)) Q:'Z D
39 . S Z0=$G(^IBA(355.92,Z,0))
40 . Q:'$P(Z0,U,6)!($P(Z0,U,7)="") ; Quit if no provider id or id type
41 . Q:'($P(Z0,U,8)=IBEFTFL)
42 . ;Q:$S($P(IBPARAM,U,3)=1:'$P($G(^IBE(355.97,+$P(Z0,U,6),1)),U,9),1:$P($G(^IBE(355.97,+$P(Z0,U,6),1)),U,9))
43 . S Z1=$G(^IBE(355.97,+$P(Z0,U,6),0))
44 . S IBS(+$P(Z0,U,5),+$P(Z0,U,3),+$P(Z1,U,2)_";"_Z,$P(Z1,U))=+$P(Z0,U,6)_U_$P(Z0,U,7)_U_Z
45 ;
46 S IBD="" F S IBD=$O(IBS(IBD)) Q:IBD="" D
47 . D:IBCT SET1(.IBLCT," ",IBCT+1)
48 . D SET1(.IBLCT,"Division: "_$$DIV(IBD),IBCT+1)
49 . S IBCU="" F S IBCU=$O(IBS(IBD,IBCU)) Q:IBCU="" D
50 .. I IBCU D SET1(.IBLCT," Care Unit: "_$$EXTERNAL^DILFD(355.92,.03,"",IBCU),IBCT+1)
51 .. S Z="" F S Z=$O(IBS(IBD,IBCU,Z),-1) Q:Z="" D
52 ... S Z0="" F S Z0=$O(IBS(IBD,IBCU,Z,Z0)) Q:Z0="" S IBX=IBS(IBD,IBCU,Z,Z0) D
53 .... S IBCT=IBCT+1
54 .... I $P(Z,";",2) D Q
55 ..... S Z00=$G(^IBA(355.92,+$P(Z,";",2),0))
56 ..... S Z1=$E(IBCT_$J("",3),1,3)_" "_$E(Z0_$J("",25),1,25)_" "_$E($S($P(IBX,U,2)'="":$P(IBX,U,2),1:$$IDNUM^IBCEP7A(+IBX))_$J("",15),1,15)_" "_$P("BOTH^UB04^1500^RX",U,$P(Z00,U,4)+1)
57 ..... D SET1(.IBLCT,Z1,IBCT)
58 ..... S ^TMP("IBCE_PRVFAC_MAINT",$J,"ZIDX",IBCT)=+$P(Z,";",2)
59 ;
60 I 'IBLCT D
61 . D SET1(1," ")
62 . N TEXT
63 . I IBEFTFL="E" S TEXT="No Billing Provider Secondary IDs found"
64 . I IBEFTFL="A" S TEXT="No Billing Provider Additional IDs found"
65 . I IBEFTFL="LF" S TEXT="No VA Lab/Facility IDs found"
66 . D SET1(2,TEXT)
67 . S IBLCT=2
68 S VALMBG=1,VALMCNT=IBLCT
69 Q
70 ;
71SET1(IBLCT,TEXT,IBCT) ;
72 S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT,$G(IBCT))
73 Q
74 ;
75DIV(IBD) ; Returns 'ALL/DEFAULT' or div NAME whose ien=IBD
76 N MAIN
77 I IBD Q $$EXTERNAL^DILFD(355.92,.05,"",IBD)
78 S MAIN=$$MAIN^IBCEP2B()
79 S MAIN=$$EXTERNAL^DILFD(355.92,.05,"",MAIN)
80 S MAIN=MAIN_"/Default for All Divisions"
81 Q MAIN
82 ;
83EDIT1 ;
84 N IBFUNC,IBINS,IBDA,Z,DIR,X,Y,DTOUT,DUOUT,DP,IBPARAM,IBEFTFL
85 D FULL^VALM1
86 S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
87 S IBEFTFL=$P(IBPARAM,U) ; Electronic Form type flag
88 S IBINS=+$P(IBPARAM,U,2) ; Insurance co
89 S IBFUNC="E"
90 D SEL
91 I $G(IBDA) S Z=$$EDITFAC(IBDA,IBFUNC,IBEFTFL) I Z D INIT
92 ;
93EDIT1Q S VALMBCK="R"
94 Q
95EXPND ;
96 Q
97HELP ;
98 Q
99EXIT ;
100 N IBPARAM,IBEFTFL
101 S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
102 S IBEFTFL=$P(IBPARAM,U) ; Electronic Form type flag
103 I IBEFTFL="A" D COPYPROV^IBCEP5A(0)
104 ;
105 S (IBLCT,IBCT)=0
106 K ^TMP("IBCE_PRVFAC_MAINT",$J),^TMP("IBCE_PRVFAC_MAINT_INS",$J)
107 D CLEAN^VALM10
108 Q
109SEL ;
110 N Z
111 K IBDA
112 D FULL^VALM1,EN^VALM2($G(XQORNOD(0)),"OS")
113 S Z=+$O(VALMY(0)) Q:'Z
114 ; fac/ins co default
115 S IBDA=$G(^TMP("IBCE_PRVFAC_MAINT",$J,"ZIDX",Z))
116 Q
117 ;
118EDITFAC(IBDA,IBFUNC,IBEFTFL) ; edits ins co facility id (355.92), entry IBDA
119 N IBRBLD,Z,Z0,DIK,DIE,DP,DA,DR,DIR,X,Y,IBDA0,IBDIV,IBITYP,IBFORM,IBCAREUN,NEXTONE
120 S IBRBLD=0 S:$G(IBDA) IBDA0=$G(^IBA(355.92,+IBDA,0))
121 ; "E"diting 355.92 entry
122 I IBFUNC="E" D
123 . S Z0=$TR(IBDA0,U)
124 . Q:'$$FACFLDS^IBCEP7C(IBDA,IBINS,.IBITYP,.IBFORM,.IBDIV,"E",.IBCAREUN,IBEFTFL)
125 . S DIE="^IBA(355.92,",DA=IBDA
126 . S DR=".03////"_$S($G(IBCAREUN)]""&($G(IBCAREUN)'="*N/A*"):IBCAREUN,1:"")_";.04////"_IBFORM_$S(IBDIV:";.05////"_IBDIV,1:"")_";.06////"_IBITYP_";"
127 . S DR=DR_".07"_$S(IBEFTFL="E"!(IBEFTFL="A"):"Billing Provider Secondary ID",1:"VA Lab or Facility Secondary ID")
128 . I IBEFTFL="A" D
129 .. S NEXTONE=$$NEXTONE()
130 .. S ^TMP("IB_EDITED_IDS",$J,NEXTONE)=IBDA_U_"MOD"_U_355.92
131 .. S ^TMP("IB_EDITED_IDS",$J,NEXTONE,"OLD0")=^IBA(355.92,IBDA,0)
132 . D ^DIE
133 . I IBEFTFL="A" S ^TMP("IB_EDITED_IDS",$J,NEXTONE,0)=^IBA(355.92,IBDA,0)
134 . I $TR($G(^IBA(355.92,IBDA,0)),U)'=Z0 S IBRBLD=1
135 ;
136 ; "D"eleting 355.92 entry
137 I IBFUNC="D" D
138 . W !!," Insurance Co: ",$P($G(^DIC(36,+IBDA0,0)),U)
139 . W !," Division: ",$$DIV($P(IBDA0,U,5))
140 . W:$P(IBDA0,U,3)]"" !," Care Unit: ",$$EXTERNAL^DILFD(355.92,.03,"",$P(IBDA0,U,3))
141 . W !," ID Qualifier: ",$$EXTERNAL^DILFD(355.92,.06,"",$P(IBDA0,U,6))
142 . W !," Form Type: ",$$EXTERNAL^DILFD(355.92,.04,"",$P(IBDA0,U,4))
143 . W !," ID: ",$P(IBDA0,U,7),!
144 . S DIR(0)="YA",DIR("A")="ARE YOU SURE YOU WANT TO DELETE THIS ID RECORD?: ",DIR("B")="NO" D ^DIR K DIR
145 . S DIR("A")="NOTHING DELETED - PRESS RETURN TO CONTINUE: "
146 . I Y=1 D
147 .. S DIK="^IBA(355.92,",DA=IBDA
148 .. D ^DIK
149 .. I IBEFTFL="A" D
150 ... N NEXTONE
151 ... S NEXTONE=$$NEXTONE()
152 ... S ^TMP("IB_EDITED_IDS",$J,NEXTONE)=IBDA_U_"DEL"_U_355.92
153 ... S ^TMP("IB_EDITED_IDS",$J,NEXTONE,0)=IBDA0
154 .. S DIR("A")="ID DELETED - PRESS RETURN TO CONTINUE: ",IBRBLD=1
155 .. S DIR(0)="EA" W ! D ^DIR K DIR
156 ;
157 Q IBRBLD
158 ;
159FACID(Y) ;
160 N Z,Z1,Z2
161 S Z=U_$P($G(^IBE(355.97,+Y,0)),U,3)_U,Z1=$$SUB2^IBCEF73(1),Z2=$$SUB2^IBCEF73(2)
162 I Z1[Z!(Z2[Z) Q 1
163 Q 0
164 ;
165ADD1 ;
166 N IBFUNC,IBINS,IBDA,Z,DIR,X,Y,DTOUT,DUOUT,DP,IBPARAM,IBEFTFL,IBINS
167 D FULL^VALM1
168 ;
169 S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
170 S IBEFTFL=$P(IBPARAM,U) ; Electronic Form type flag
171 S IBINS=+$P(IBPARAM,U,2) ; Insurance co ;
172 ;
173 S Z=$$ADDFAC^IBCEP7A(IBINS,IBEFTFL) I Z D INIT
174 ;
175ADD1Q S VALMBCK="R"
176 Q
177 ;
178DEL1 ;
179 N IBFUNC,IBINS,IBDA,Z,DIR,X,Y,DTOUT,DUOUT,DP,IBPARAM,IBEFTDL,IBINS
180 D FULL^VALM1
181 ;
182 S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
183 S IBEFTFL=$P(IBPARAM,U) ; Electronic Form type flag
184 S IBINS=+$P(IBPARAM,U,2) ; Insurance co
185 ;
186 S IBFUNC="D"
187 D SEL
188 I $G(IBDA) S Z=$$EDITFAC(IBDA,IBFUNC,IBEFTFL) I Z D INIT
189 ;
190DEL1Q S VALMBCK="R"
191 Q
192 ;
193 ; Get the next number so that the edits can be replicated in order for other providers/insurance companies
194NEXTONE() ;
195 Q $O(^TMP("IB_EDITED_IDS",$J,""),-1)+1
Note: See TracBrowser for help on using the repository browser.