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

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

initial load of WorldVistAEHR
File size: 2.7 KB
Line 
1IBCEP8B ;ALB/CJS - Functions for NON-VA PROVIDER cont'd ;06-06-08
2 ;;2.0;INTEGRATED BILLING;**391**;21-MAR-94;Build 39
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5BLD(IBNPRV) ; Build/Rebuild display
6 N IBLCT,IBCT,IBLST,IBPRI,IBIEN,Z,Z1,Z2
7 K @VALMAR
8 S (IBLCT,IBCT)=0,Z=$G(^IBA(355.93,IBNPRV,0))
9 S IBCT=IBCT+1
10 S Z1=$J("Name: ",15)_$P(Z,U) D SET1(.IBLCT,Z1,IBCT)
11 I $P(Z,U,2)=2 D
12 . S IBCT=IBCT+1
13 . S Z1=$J("Type: ",15)_$S($P(Z,U,2)=2:"INDIVIDUAL PROVIDER",1:"OUTSIDE OR OTHER VA FACILITY") D SET1(.IBLCT,Z1,IBCT)
14 . S IBCT=IBCT+1
15 . S Z1=$J("Credentials: ",15)_$P(Z,U,3) D SET1(.IBLCT,Z1,IBCT)
16 . S IBCT=IBCT+1
17 . S Z1=$J("Specialty: ",15)_$P(Z,U,4) D SET1(.IBLCT,Z1,IBCT)
18 . S IBCT=IBCT+1
19 . S Z1=$J("NPI: ",15)_$$NPIGET^IBCEP81(IBNPRV) D SET1(.IBLCT,Z1,IBCT)
20 . S IBCT=IBCT+1
21 . S IBPRI=$$TAXGET^IBCEP81(IBNPRV,.IBLST)
22 . S Z1=$J("Taxonomy Code: ",15)_$P(IBPRI,U)
23 . I $D(IBLST) S Z1=Z1_" ("_$S($P(IBLST(IBLST),U,3)=1:"Primary",1:"Secondary")_")"
24 . D SET1(.IBLCT,Z1,IBCT)
25 . S IBIEN=""
26 . F S IBIEN=$O(IBLST(IBIEN)) Q:IBIEN="" D
27 .. I IBIEN=IBLST Q
28 .. S IBCT=IBCT+1
29 .. S Z1=$J("",15)_$P(IBLST(IBIEN),U)_" ("_$S($P(IBLST(IBIEN),U,3)=1:"Primary",1:"Secondary")_")"
30 .. D SET1(.IBLCT,Z1,IBCT)
31 E D
32 . S IBCT=IBCT+1
33 . S Z1=$J("Address: ",15)_$P(Z,U,5) D SET1(.IBLCT,Z1,IBCT)
34 . I $P(Z,U,10) D
35 .. S IBCT=IBCT+1
36 .. S Z1=$J("",15)_$P(Z,U,10)
37 . S IBCT=IBCT+1
38 . S Z1=$J("",15)_$P(Z,U,6)_$S($P(Z,U,6)'="":", ",1:"")_$S($P(Z,U,7):$$EXTERNAL^DILFD(355.93,.07,"",$P(Z,U,7))_" ",1:"")_$P(Z,U,8)
39 . D SET1(.IBLCT,Z1,IBCT)
40 . S IBCT=IBCT+1
41 . S Z1=" " D SET1(.IBLCT,Z1,IBCT)
42 . S IBCT=IBCT+1
43 . S Z1=$J("Type of Facility: ",30)_$$EXTERNAL^DILFD(355.93,.11,,$P(Z,U,11))
44 . D SET1(.IBLCT,Z1,IBCT)
45 . S IBCT=IBCT+1
46 . S Z1=$J("Primary ID: ",30)_$P(Z,U,9)
47 . D SET1(.IBLCT,Z1,IBCT)
48 . S IBCT=IBCT+1
49 . S Z1=$J("ID Qualifier: ",30)_$$GET1^DIQ(355.97,$P(Z,U,13),.03) I $P(Z,U,13)]"" S Z1=Z1_" - "_$$GET1^DIQ(355.97,$P(Z,U,13),.01)
50 . D SET1(.IBLCT,Z1,IBCT)
51 . S IBCT=IBCT+1
52 . S Z1=$J("Mammography Certification #: ",30)_$P(Z,U,15)
53 . D SET1(.IBLCT,Z1,IBCT)
54 . S IBCT=IBCT+1
55 . S Z1=$J("NPI: ",30)_$$NPIGET^IBCEP81(IBNPRV) D SET1(.IBLCT,Z1,IBCT)
56 . S IBCT=IBCT+1
57 . S IBPRI=$$TAXGET^IBCEP81(IBNPRV,.IBLST)
58 . S Z1=$J("Taxonomy Code: ",30)_$P(IBPRI,U)
59 . I $D(IBLST) S Z1=Z1_" ("_$S($P(IBLST(IBLST),U,3)=1:"Primary",1:"Secondary")_")"
60 . D SET1(.IBLCT,Z1,IBCT)
61 . S IBIEN=""
62 . F S IBIEN=$O(IBLST(IBIEN)) Q:IBIEN="" D
63 .. I IBIEN=IBLST Q
64 .. S IBCT=IBCT+1
65 .. S Z1=$J("",30)_$P(IBLST(IBIEN),U)_" ("_$S($P(IBLST(IBIEN),U,3)=1:"Primary",1:"Secondary")_")"
66 .. D SET1(.IBLCT,Z1,IBCT)
67 K VALMBG,VALMCNT
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
Note: See TracBrowser for help on using the repository browser.