| [613] | 1 | IBCEP8B ;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 | ;
|
|---|
| 5 | BLD(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 | ;
|
|---|
| 71 | SET1(IBLCT,TEXT,IBCT) ;
|
|---|
| 72 | S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT,$G(IBCT))
|
|---|
| 73 | Q
|
|---|
