296 lines
10 KiB
Mathematica
296 lines
10 KiB
Mathematica
|
IBCEP8 ;ALB/TMP - Functions for NON-VA PROVIDER ;11-07-00
|
||
|
|
;;2.0;INTEGRATED BILLING;**51,137,232,288,320,343,374,377**;21-MAR-94;Build 23
|
||
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
||
|
|
;
|
||
|
|
EN ; -- main entry point
|
||
|
|
N IBNPRV
|
||
|
|
K IBFASTXT
|
||
|
|
D FULL^VALM1
|
||
|
|
D EN^VALM("IBCE PRVNVA MAINT")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
HDR ; -- header code
|
||
|
|
K VALMHDR
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
INIT ; Initialization
|
||
|
|
N DIC,DA,X,Y,DLAYGO,IBIF,DIR,DTOUT,DUOUT
|
||
|
|
K ^TMP("IBCE_PRVNVA_MAINT",$J)
|
||
|
|
;
|
||
|
|
; if coming in from main routine ^IBCEP6 this special variable IBNVPMIF is set already
|
||
|
|
I $G(IBNVPMIF)'="" S IBIF=IBNVPMIF G INIT1
|
||
|
|
;
|
||
|
|
S DIR("A")="(I)NDIVIDUAL OR (F)ACILITY?: ",DIR(0)="SA^I:INDIVIDUAL;F:FACILITY" D ^DIR K DIR
|
||
|
|
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 G INITQ
|
||
|
|
S IBIF=Y
|
||
|
|
;
|
||
|
|
INIT1 ;
|
||
|
|
;
|
||
|
|
I IBIF="F" D
|
||
|
|
. S VALM("TITLE")="Non-VA Lab or Facility Info"
|
||
|
|
. K VALM("PROTOCOL")
|
||
|
|
. S Y=$$FIND1^DIC(101,,,"IBCE PRVNVA NONIND MAINT")
|
||
|
|
. I Y S VALM("PROTOCOL")=+Y_";ORD(101,"
|
||
|
|
;
|
||
|
|
S DIC="^IBA(355.93,",DIC("DR")=".02///"_$S(IBIF'="F":2,1:1)
|
||
|
|
S DIC("S")="I $P(^(0),U,2)="_$S(IBIF'="F":2,1:1)
|
||
|
|
S DLAYGO=355.93,DIC(0)="AELMQ",DIC("A")="Select a NON"_$S(IBIF="I":"-",1:"/OTHER ")_"VA PROVIDER: "
|
||
|
|
D ^DIC K DIC,DLAYGO
|
||
|
|
I Y'>0 S VALMQUIT=1 G INITQ
|
||
|
|
S IBNPRV=+Y
|
||
|
|
D BLD
|
||
|
|
INITQ Q
|
||
|
|
;
|
||
|
|
BLD ; Build/Rebuild display
|
||
|
|
N IBLCT,IBCT,IBLST,IBPRI,IBIEN,Z,Z1,Z2
|
||
|
|
K @VALMAR
|
||
|
|
S (IBLCT,IBCT)=0,Z=$G(^IBA(355.93,IBNPRV,0))
|
||
|
|
S IBCT=IBCT+1
|
||
|
|
S Z1=$J("Name: ",15)_$P(Z,U) D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
I $P(Z,U,2)=2 D
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Type: ",15)_$S($P(Z,U,2)=2:"INDIVIDUAL PROVIDER",1:"OUTSIDE OR OTHER VA FACILITY") D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Credentials: ",15)_$P(Z,U,3) D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Specialty: ",15)_$P(Z,U,4) D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("NPI: ",15)_$$NPIGET^IBCEP81(IBNPRV) D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S IBPRI=$$TAXGET^IBCEP81(IBNPRV,.IBLST)
|
||
|
|
. S Z1=$J("Taxonomy Code: ",15)_$P(IBPRI,U)
|
||
|
|
. I $D(IBLST) S Z1=Z1_" ("_$S($P(IBLST(IBLST),U,3)=1:"Primary",1:"Secondary")_")"
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBIEN=""
|
||
|
|
. F S IBIEN=$O(IBLST(IBIEN)) Q:IBIEN="" D
|
||
|
|
.. I IBIEN=IBLST Q
|
||
|
|
.. S IBCT=IBCT+1
|
||
|
|
.. S Z1=$J("",15)_$P(IBLST(IBIEN),U)_" ("_$S($P(IBLST(IBIEN),U,3)=1:"Primary",1:"Secondary")_")"
|
||
|
|
.. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
E D
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Address: ",15)_$P(Z,U,5) D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. I $P(Z,U,10) D
|
||
|
|
.. S IBCT=IBCT+1
|
||
|
|
.. S Z1=$J("",15)_$P(Z,U,10)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. 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)
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=" " D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Type of Facility: ",30)_$$EXTERNAL^DILFD(355.93,.11,,$P(Z,U,11))
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Primary ID: ",30)_$P(Z,U,9)
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. 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)
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("Mammography Certification #: ",30)_$P(Z,U,15)
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S Z1=$J("NPI: ",30)_$$NPIGET^IBCEP81(IBNPRV) D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBCT=IBCT+1
|
||
|
|
. S IBPRI=$$TAXGET^IBCEP81(IBNPRV,.IBLST)
|
||
|
|
. S Z1=$J("Taxonomy Code: ",30)_$P(IBPRI,U)
|
||
|
|
. I $D(IBLST) S Z1=Z1_" ("_$S($P(IBLST(IBLST),U,3)=1:"Primary",1:"Secondary")_")"
|
||
|
|
. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
. S IBIEN=""
|
||
|
|
. F S IBIEN=$O(IBLST(IBIEN)) Q:IBIEN="" D
|
||
|
|
.. I IBIEN=IBLST Q
|
||
|
|
.. S IBCT=IBCT+1
|
||
|
|
.. S Z1=$J("",30)_$P(IBLST(IBIEN),U)_" ("_$S($P(IBLST(IBIEN),U,3)=1:"Primary",1:"Secondary")_")"
|
||
|
|
.. D SET1(.IBLCT,Z1,IBCT)
|
||
|
|
K VALMBG,VALMCNT
|
||
|
|
S VALMBG=1,VALMCNT=IBLCT
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SET1(IBLCT,TEXT,IBCT) ;
|
||
|
|
S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT,$G(IBCT))
|
||
|
|
Q
|
||
|
|
EXPND ;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
HELP ;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EXIT ;
|
||
|
|
K ^TMP("IBCE_PRVNVA_MAINT",$J)
|
||
|
|
D CLEAN^VALM10
|
||
|
|
K IBFASTXT
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EDIT1(IBNPRV,IBNOLM) ; Edit non-VA provider/facility demographics
|
||
|
|
; IBNPRV = ien of entry in file 355.93
|
||
|
|
; IBNOLM = 1 if not called from list manager
|
||
|
|
;
|
||
|
|
N DA,X,Y,DIE,DR,IBP
|
||
|
|
I '$G(IBNOLM) D FULL^VALM1
|
||
|
|
I IBNPRV D
|
||
|
|
. I '$G(IBNOLM) D CLEAR^VALM1
|
||
|
|
. S DIE="^IBA(355.93,",DA=IBNPRV,IBP=($P($G(^IBA(355.93,IBNPRV,0)),U,2)=2)
|
||
|
|
. ; PRXM/KJH - Added NPI and Taxonomy to the list of fields to be edited. Put a "NO^" around the Taxonomy multiple (#42) since some of the sub-field entries are 'required'.
|
||
|
|
. S DR=".01;"_$S(IBP:".03;.04",1:".05;.1;.06;.07;.08;.13///24;W !,""ID Qualifier: 24 - EMPLOYER'S IDENTIFICATION #"";.09Lab or Facility Primary ID;.11;.15")_";D EN^IBCEP82;S DIE(""NO^"")="""";42;K DIE(""NO^"")"
|
||
|
|
. D ^DIE
|
||
|
|
. Q:$G(IBNOLM)
|
||
|
|
. D BLD
|
||
|
|
I '$G(IBNOLM) K VALMBCK S VALMBCK="R"
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EDITID(IBNPRV,IBSLEV) ; Link from this list template to maintain provider-specific ids
|
||
|
|
; This entry point is called by 4 action protocols.
|
||
|
|
; IBNPRV = ien of entry in file 355.93 (can be either an individual or a facility) (required)
|
||
|
|
; IBSLEV = 1 for facility/provider own ID's
|
||
|
|
; IBSLEV = 2 for facility/provider ID's furnished by an insurance company
|
||
|
|
;
|
||
|
|
Q:'$G(IBNPRV)
|
||
|
|
Q:'$G(IBSLEV)
|
||
|
|
N IBPRV,IBIF
|
||
|
|
D FULL^VALM1 ; set full scrolling region
|
||
|
|
D CLEAR^VALM1 ; clear screen
|
||
|
|
S IBPRV=IBNPRV
|
||
|
|
;
|
||
|
|
K IBFASTXT
|
||
|
|
S IBIF=$$GET1^DIQ(355.93,IBPRV,.02,"I") ; 1=facility/group 2=individual
|
||
|
|
D EN^VALM("IBCE PRVPRV MAINT")
|
||
|
|
;
|
||
|
|
K VALMQUIT
|
||
|
|
S VALMBCK=$S($G(IBFASTXT)'="":"Q",1:"R")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
NVAFAC ; Enter/edit Non-VA facility information
|
||
|
|
; This entry point is called by the menu system for option IBCE PRVNVA FAC EDIT
|
||
|
|
N X,Y,DA,DIC,IBNPRV,DLAYGO
|
||
|
|
S DIC="^IBA(355.93,",DIC("S")="I $P(^(0),U,2)=1",DIC("DR")=".02///1"
|
||
|
|
S DLAYGO=355.93,DIC(0)="AELMQ",DIC("A")="Select a NON/Other VA FACILITY: "
|
||
|
|
D ^DIC K DIC,DLAYGO
|
||
|
|
I Y'>0 S VALMQUIT=1 G NVAFACQ
|
||
|
|
S IBNPRV=+Y
|
||
|
|
D EDIT1(IBNPRV,1)
|
||
|
|
;
|
||
|
|
NVAFACQ Q
|
||
|
|
;
|
||
|
|
GETFAC(IB,IBFILE,IBELE,IBSFD) ; Returns facility name,address lines or city-state-zip
|
||
|
|
; IB = ien of entry in file
|
||
|
|
; IBFILE = 0 for retrieval from file 4, 1 for retrieval from file 355.93
|
||
|
|
; If IBELE=0, returns name
|
||
|
|
; =1, returns address line 1
|
||
|
|
; =2, returns address line 2
|
||
|
|
; =3, returns city, state zip
|
||
|
|
; = "3C", returns city = "3S", state = "3Z", zip
|
||
|
|
; IBSFD (optional) = Output formatter segment name if the output needs
|
||
|
|
; to be screened thru the VAMCFD^IBCEF75 procedure for the flag
|
||
|
|
; in the insurance company file
|
||
|
|
;
|
||
|
|
N Z,IBX,IBZ
|
||
|
|
S IBX=""
|
||
|
|
;
|
||
|
|
I $G(IBSFD)="SUB" D VAMCFD^IBCEF75(+$G(IBXIEN),.IBZ) I $D(IBZ),'$G(IBZ("C",1)) G GETFACX
|
||
|
|
;
|
||
|
|
S Z=$S('IBFILE:$G(^DIC(4,+IB,1)),1:$G(^IBA(355.93,+IB,0)))
|
||
|
|
I +IBELE=0 S IBX=$S('IBFILE:$P($G(^DIC(4,+IB,0)),U),1:$P($G(^IBA(355.93,+IB,0)),U))
|
||
|
|
I IBELE=1!(IBELE=12) S IBX=$S('IBFILE:$P(Z,U),1:$P(Z,U,5))
|
||
|
|
I IBELE=2!(IBELE=12) S IBX=$S(IBELE=12:IBX_" ",1:"")_$S('IBFILE:$P(Z,U,2),1:$P(Z,U,10))
|
||
|
|
;
|
||
|
|
I +IBELE=3,'IBFILE D
|
||
|
|
. S:IBELE=3!(IBELE["C") IBX=$P(Z,U,3) Q:IBELE["C"
|
||
|
|
. S:IBELE=3 IBX=IBX_$S(IBX'="":", ",1:"") S:IBELE=3!(IBELE["S") IBX=IBX_$$STATE^IBCEFG1($P($G(^DIC(4,+IB,0)),U,2)) Q:IBELE["S"
|
||
|
|
. S:IBELE=3 IBX=IBX_" " S:IBELE=3!(IBELE["Z") IBX=IBX_$P(Z,U,4)
|
||
|
|
. Q
|
||
|
|
;
|
||
|
|
I +IBELE=3,IBFILE D
|
||
|
|
. S:IBELE=3!(IBELE["C") IBX=$P(Z,U,6) Q:IBELE["C"
|
||
|
|
. S:IBELE=3 IBX=IBX_$S(IBX'="":", ",1:"") S:IBELE=3!(IBELE["S") IBX=IBX_$$STATE^IBCEFG1($P(Z,U,7))
|
||
|
|
. S:IBELE=3 IBX=IBX_" " S:IBELE=3!(IBELE["Z") IBX=IBX_$P(Z,U,8)
|
||
|
|
. Q
|
||
|
|
GETFACX ;
|
||
|
|
Q IBX
|
||
|
|
;
|
||
|
|
ALLID(IBPRV,IBPTYP,IBZ) ; Returns array IBZ for all ids for provider IBPRV
|
||
|
|
; for all provider id types or for id type in IBPTYP
|
||
|
|
; IBPRV = vp ien of provider
|
||
|
|
; IBPTYP = ien of provider id type to return or "" for all
|
||
|
|
; IBZ = array returned with internal data:
|
||
|
|
; IBZ(file 355.9 ien)=ID type^ID#^ins co^form type^bill care type^care un^X12 code for id type
|
||
|
|
N Z,Z0
|
||
|
|
K IBZ
|
||
|
|
G:'$G(IBPRV) ALLIDQ
|
||
|
|
S IBPTYP=$G(IBPTYP)
|
||
|
|
S Z=0 F S Z=$O(^IBA(355.9,"B",IBPRV,Z)) Q:'Z S Z0=$G(^IBA(355.9,Z,0)) D
|
||
|
|
. I $S(IBPTYP="":1,1:($P(Z0,U,6)=IBPTYP)) S IBZ(Z)=($P(Z0,U,6)_U_$P(Z0,U,7)_U_$P(Z0,U,2)_U_$P(Z0,U,4)_U_$P(Z0,U,5)_U_$P(Z0,U,3))_U_$P($G(^IBE(355.97,+$P(Z0,U,6),0)),U,3)
|
||
|
|
;
|
||
|
|
ALLIDQ Q
|
||
|
|
;
|
||
|
|
CLIA() ; Returns ien of CLIA # provider id type
|
||
|
|
N Z,IBZ
|
||
|
|
S (IBZ,Z)=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z I $P($G(^(Z,0)),U,3)="X4",$P(^(0),U)["CLIA" S IBZ=Z Q
|
||
|
|
Q IBZ
|
||
|
|
;
|
||
|
|
STLIC() ; Returns ien of STLIC# provider id type
|
||
|
|
N Z,IBZ
|
||
|
|
S (IBZ,Z)=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z I $P($G(^(Z,1)),U,3) S IBZ=Z Q
|
||
|
|
Q IBZ
|
||
|
|
;
|
||
|
|
TAXID() ; Returns ien of Fed tax id provider id type
|
||
|
|
N Z,IBZ
|
||
|
|
S (IBZ,Z)=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z I $P($G(^(Z,1)),U,4) S IBZ=Z Q
|
||
|
|
Q IBZ
|
||
|
|
;
|
||
|
|
CLIANVA(IBIFN) ; Returns CLIA # for a non-VA facility on bill ien IBIFN
|
||
|
|
N IBCLIA,IBZ,IBNVA,Z
|
||
|
|
S IBCLIA="",IBZ=$$CLIA()
|
||
|
|
I IBZ D
|
||
|
|
. S IBNVA=$P($G(^DGCR(399,IBIFN,"U2")),U,10) Q:'IBNVA
|
||
|
|
. S IBCLIA=$$IDFIND^IBCEP2(IBIFN,IBZ,IBNVA_";IBA(355.93,","",1)
|
||
|
|
Q IBCLIA
|
||
|
|
;
|
||
|
|
VALFAC(X) ; Function returns 1 if format is valid for X12 facility name
|
||
|
|
; Alpha/numeric/certain punctuation valid. Must start with an Alpha
|
||
|
|
N OK,VAL
|
||
|
|
S OK=1
|
||
|
|
S VAL("A")="",VAL("N")="",VAL=",.- "
|
||
|
|
I $E(X)'?1A!'$$VALFMT(X,.VAL) S OK=0
|
||
|
|
Q OK
|
||
|
|
;
|
||
|
|
VALFMT(X,VAL) ; Returns 1 if format of X is valid, 0 if not
|
||
|
|
; X = data to be examined
|
||
|
|
; VAL = a 'string' of valid characters AND/OR (passed by reference)
|
||
|
|
; if VAL("A") defined ==> Alpha
|
||
|
|
; if VAL("A") defined ==> Numeric valid
|
||
|
|
; if VAL("A") defined ==> Punctuation valid
|
||
|
|
; any other character included in the string is checked individually
|
||
|
|
N Z
|
||
|
|
I $D(VAL("A")) D
|
||
|
|
. N Z0
|
||
|
|
. F Z=1:1:$L(X) I $E(X,Z)?1A S Z0(Z)=""
|
||
|
|
. S Z0="" F S Z0=$O(Z0(Z0),-1) Q:'Z0 S $E(X,Z0)=""
|
||
|
|
I $D(VAL("N")) D
|
||
|
|
. N Z0
|
||
|
|
. F Z=1:1:$L(X) I $E(X,Z)?1N S Z0(Z)=""
|
||
|
|
. S Z0="" F S Z0=$O(Z0(Z0),-1) Q:'Z0 S $E(X,Z0)=""
|
||
|
|
I $D(VAL("P")) D
|
||
|
|
. N Z0
|
||
|
|
. F Z=1:1:$L(X) I $E(X,Z)?1P S Z0(Z)=""
|
||
|
|
. S Z0="" F S Z0=$O(Z0(Z0),-1) Q:'Z0 S $E(X,Z0)=""
|
||
|
|
I $G(VAL)'="" S X=$TR(X,VAL,"")
|
||
|
|
Q (X="")
|
||
|
|
;
|
||
|
|
PS(IBXSAVE) ; Returns 1 if IBXSAVE("PSVC") indicates the svc was non-lab
|
||
|
|
;
|
||
|
|
Q $S($G(IBXSAVE("PSVC"))="":0,1:"13"[IBXSAVE("PSVC"))
|
||
|
|
;
|
||
|
|
; Pass in the Internal Entry number to File 355.93
|
||
|
|
; Return the Primary ID and Qualifier (ID Type) from 355.9
|
||
|
|
PRIMID(IEN35593) ; Return External Primary ID and ID Quailier
|
||
|
|
N INDXVAL,LIST,MSG,IDCODE
|
||
|
|
S INDXVAL=IEN35593_";IBA(355.93,"
|
||
|
|
N SCREEN S SCREEN="I $P(^(0),U,8)"
|
||
|
|
D FIND^DIC(355.9,,"@;.06EI;.07","Q",INDXVAL,,,SCREEN,,"LIST","MSG")
|
||
|
|
I '+$G(LIST("DILIST",0)) Q "" ; No Primary ID
|
||
|
|
I +$G(LIST("DILIST",0))>1 Q "***ERROR***^***ERROR***" ; Bad. More than one.
|
||
|
|
; Found just one
|
||
|
|
S IDCODE=$$GET1^DIQ(355.97,LIST("DILIST","ID",1,.06,"I"),.03)
|
||
|
|
Q $G(LIST("DILIST","ID",1,.07))_U_IDCODE_" - "_$G(LIST("DILIST","ID",1,.06,"E"))
|