[623] | 1 | IBCEP8 ;ALB/TMP - Functions for NON-VA PROVIDER ;11-07-00
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**51,137,232,288,320,343,374**;21-MAR-94;Build 16
|
---|
| 3 | ;
|
---|
| 4 | EN ; -- main entry point
|
---|
| 5 | N IBNPRV
|
---|
| 6 | K IBFASTXT
|
---|
| 7 | D FULL^VALM1
|
---|
| 8 | D EN^VALM("IBCE PRVNVA MAINT")
|
---|
| 9 | Q
|
---|
| 10 | ;
|
---|
| 11 | HDR ; -- header code
|
---|
| 12 | K VALMHDR
|
---|
| 13 | Q
|
---|
| 14 | ;
|
---|
| 15 | INIT ; Initialization
|
---|
| 16 | N DIC,DA,X,Y,DLAYGO,IBIF,DIR,DTOUT,DUOUT
|
---|
| 17 | K ^TMP("IBCE_PRVNVA_MAINT",$J)
|
---|
| 18 | S DIR("A")="(I)NDIVIDUAL OR (F)ACILITY?: ",DIR(0)="SA^I:INDIVIDUAL;F:FACILITY" D ^DIR K DIR
|
---|
| 19 | I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 G INITQ
|
---|
| 20 | S IBIF=Y
|
---|
| 21 | ;
|
---|
| 22 | I IBIF="F" D
|
---|
| 23 | . S VALM("TITLE")="Non-VA Lab or Facility Info"
|
---|
| 24 | . K VALM("PROTOCOL")
|
---|
| 25 | . S Y=$$FIND1^DIC(101,,,"IBCE PRVNVA NONIND MAINT")
|
---|
| 26 | . I Y S VALM("PROTOCOL")=+Y_";ORD(101,"
|
---|
| 27 | ;
|
---|
| 28 | S DIC="^IBA(355.93,",DIC("DR")=".02////"_$S(IBIF'="F":2,1:1)
|
---|
| 29 | S DIC("S")="I $P(^(0),U,2)="_$S(IBIF'="F":2,1:1)
|
---|
| 30 | S DLAYGO=355.93,DIC(0)="AELMQ",DIC("A")="Select a NON"_$S(IBIF="I":"-",1:"/OTHER ")_"VA PROVIDER: "
|
---|
| 31 | D ^DIC K DIC,DLAYGO
|
---|
| 32 | I Y'>0 S VALMQUIT=1 G INITQ
|
---|
| 33 | S IBNPRV=+Y
|
---|
| 34 | D BLD
|
---|
| 35 | INITQ Q
|
---|
| 36 | ;
|
---|
| 37 | BLD ; Build/Rebuild display
|
---|
| 38 | N IBLCT,IBCT,IBLST,IBPRI,IBIEN,Z,Z1,Z2
|
---|
| 39 | K @VALMAR
|
---|
| 40 | S (IBLCT,IBCT)=0,Z=$G(^IBA(355.93,IBNPRV,0))
|
---|
| 41 | S IBCT=IBCT+1
|
---|
| 42 | S Z1=$J("Name: ",15)_$P(Z,U) D SET1(.IBLCT,Z1,IBCT)
|
---|
| 43 | I $P(Z,U,2)=2 D
|
---|
| 44 | . S IBCT=IBCT+1
|
---|
| 45 | . S Z1=$J("Type: ",15)_$S($P(Z,U,2)=2:"INDIVIDUAL PROVIDER",1:"OUTSIDE OR OTHER VA FACILITY") D SET1(.IBLCT,Z1,IBCT)
|
---|
| 46 | . S IBCT=IBCT+1
|
---|
| 47 | . S Z1=$J("Credentials: ",15)_$P(Z,U,3) D SET1(.IBLCT,Z1,IBCT)
|
---|
| 48 | . S IBCT=IBCT+1
|
---|
| 49 | . S Z1=$J("Specialty: ",15)_$P(Z,U,4) D SET1(.IBLCT,Z1,IBCT)
|
---|
| 50 | . S IBCT=IBCT+1
|
---|
| 51 | . S Z1=$J("NPI: ",15)_$$NPIGET^IBCEP81(IBNPRV) D SET1(.IBLCT,Z1,IBCT)
|
---|
| 52 | . S IBCT=IBCT+1
|
---|
| 53 | . S IBPRI=$$TAXGET^IBCEP81(IBNPRV,.IBLST)
|
---|
| 54 | . S Z1=$J("Taxonomy Code: ",15)_$P(IBPRI,U)
|
---|
| 55 | . I $D(IBLST) S Z1=Z1_" ("_$S($P(IBLST(IBLST),U,3)=1:"Primary",1:"Secondary")_")"
|
---|
| 56 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 57 | . S IBIEN=""
|
---|
| 58 | . F S IBIEN=$O(IBLST(IBIEN)) Q:IBIEN="" D
|
---|
| 59 | .. I IBIEN=IBLST Q
|
---|
| 60 | .. S IBCT=IBCT+1
|
---|
| 61 | .. S Z1=$J("",15)_$P(IBLST(IBIEN),U)_" ("_$S($P(IBLST(IBIEN),U,3)=1:"Primary",1:"Secondary")_")"
|
---|
| 62 | .. D SET1(.IBLCT,Z1,IBCT)
|
---|
| 63 | E D
|
---|
| 64 | . S IBCT=IBCT+1
|
---|
| 65 | . S Z1=$J("Address: ",15)_$P(Z,U,5) D SET1(.IBLCT,Z1,IBCT)
|
---|
| 66 | . I $P(Z,U,10) D
|
---|
| 67 | .. S IBCT=IBCT+1
|
---|
| 68 | .. S Z1=$J("",15)_$P(Z,U,10)
|
---|
| 69 | . S IBCT=IBCT+1
|
---|
| 70 | . 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)
|
---|
| 71 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 72 | . S IBCT=IBCT+1
|
---|
| 73 | . S Z1=" " D SET1(.IBLCT,Z1,IBCT)
|
---|
| 74 | . S IBCT=IBCT+1
|
---|
| 75 | . S Z1=$J("Type of Facility: ",30)_$$EXTERNAL^DILFD(355.93,.11,,$P(Z,U,11))
|
---|
| 76 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 77 | . S IBCT=IBCT+1
|
---|
| 78 | . S Z1=$J("Primary ID: ",30)_$P(Z,U,9)
|
---|
| 79 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 80 | . S IBCT=IBCT+1
|
---|
| 81 | . 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)
|
---|
| 82 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 83 | . S IBCT=IBCT+1
|
---|
| 84 | . S Z1=$J("Mammography Certification #: ",30)_$P(Z,U,15)
|
---|
| 85 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 86 | . S IBCT=IBCT+1
|
---|
| 87 | . S Z1=$J("NPI: ",30)_$$NPIGET^IBCEP81(IBNPRV) D SET1(.IBLCT,Z1,IBCT)
|
---|
| 88 | . S IBCT=IBCT+1
|
---|
| 89 | . S IBPRI=$$TAXGET^IBCEP81(IBNPRV,.IBLST)
|
---|
| 90 | . S Z1=$J("Taxonomy Code: ",30)_$P(IBPRI,U)
|
---|
| 91 | . I $D(IBLST) S Z1=Z1_" ("_$S($P(IBLST(IBLST),U,3)=1:"Primary",1:"Secondary")_")"
|
---|
| 92 | . D SET1(.IBLCT,Z1,IBCT)
|
---|
| 93 | . S IBIEN=""
|
---|
| 94 | . F S IBIEN=$O(IBLST(IBIEN)) Q:IBIEN="" D
|
---|
| 95 | .. I IBIEN=IBLST Q
|
---|
| 96 | .. S IBCT=IBCT+1
|
---|
| 97 | .. S Z1=$J("",30)_$P(IBLST(IBIEN),U)_" ("_$S($P(IBLST(IBIEN),U,3)=1:"Primary",1:"Secondary")_")"
|
---|
| 98 | .. D SET1(.IBLCT,Z1,IBCT)
|
---|
| 99 | K VALMBG,VALMCNT
|
---|
| 100 | S VALMBG=1,VALMCNT=IBLCT
|
---|
| 101 | Q
|
---|
| 102 | ;
|
---|
| 103 | SET1(IBLCT,TEXT,IBCT) ;
|
---|
| 104 | S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT,$G(IBCT))
|
---|
| 105 | Q
|
---|
| 106 | EXPND ;
|
---|
| 107 | Q
|
---|
| 108 | ;
|
---|
| 109 | HELP ;
|
---|
| 110 | Q
|
---|
| 111 | ;
|
---|
| 112 | EXIT ;
|
---|
| 113 | K ^TMP("IBCE_PRVNVA_MAINT",$J)
|
---|
| 114 | D CLEAN^VALM10
|
---|
| 115 | K IBFASTXT
|
---|
| 116 | Q
|
---|
| 117 | ;
|
---|
| 118 | EDIT1(IBNPRV,IBNOLM) ; Edit non-VA provider/facility demographics
|
---|
| 119 | ; IBNPRV = ien of entry in file 355.93
|
---|
| 120 | ; IBNOLM = 1 if not called from list manager
|
---|
| 121 | ;
|
---|
| 122 | N DA,X,Y,DIE,DR,IBP
|
---|
| 123 | I '$G(IBNOLM) D FULL^VALM1
|
---|
| 124 | I IBNPRV D
|
---|
| 125 | . I '$G(IBNOLM) D CLEAR^VALM1
|
---|
| 126 | . S DIE="^IBA(355.93,",DA=IBNPRV,IBP=($P($G(^IBA(355.93,IBNPRV,0)),U,2)=2)
|
---|
| 127 | . ; 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'.
|
---|
| 128 | . 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^"")"
|
---|
| 129 | . D ^DIE
|
---|
| 130 | . Q:$G(IBNOLM)
|
---|
| 131 | . D BLD
|
---|
| 132 | I '$G(IBNOLM) K VALMBCK S VALMBCK="R"
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | EDITID(IBNPRV) ; Link from this list template to maintain provider-specific ids
|
---|
| 136 | ; IBNPRV = ien of entry in file 355.93
|
---|
| 137 | N IBPRV
|
---|
| 138 | D FULL^VALM1
|
---|
| 139 | D CLEAR^VALM1
|
---|
| 140 | S IBPRV=IBNPRV
|
---|
| 141 | D EN1^IBCEP5
|
---|
| 142 | K VALMQUIT
|
---|
| 143 | S VALMBCK="R"
|
---|
| 144 | Q
|
---|
| 145 | ;
|
---|
| 146 | NVAFAC ; Enter/edit Non-VA facility information
|
---|
| 147 | N X,Y,DA,DIC,IBNPRV,DLAYGO
|
---|
| 148 | S DIC="^IBA(355.93,",DIC("S")="I $P(^(0),U,2)=1",DIC("DR")=".02////1"
|
---|
| 149 | S DLAYGO=355.93,DIC(0)="AELMQ",DIC("A")="Select a NON/Other VA FACILITY: "
|
---|
| 150 | D ^DIC K DIC,DLAYGO
|
---|
| 151 | I Y'>0 S VALMQUIT=1 G NVAFACQ
|
---|
| 152 | S IBNPRV=+Y
|
---|
| 153 | D EDIT1(IBNPRV,1)
|
---|
| 154 | ;
|
---|
| 155 | NVAFACQ Q
|
---|
| 156 | ;
|
---|
| 157 | GETFAC(IB,IBFILE,IBELE,IBSFD) ; Returns facility name,address lines or city-state-zip
|
---|
| 158 | ; IB = ien of entry in file
|
---|
| 159 | ; IBFILE = 0 for retrieval from file 4, 1 for retrieval from file 355.93
|
---|
| 160 | ; If IBELE=0, returns name
|
---|
| 161 | ; =1, returns address line 1
|
---|
| 162 | ; =2, returns address line 2
|
---|
| 163 | ; =3, returns city, state zip
|
---|
| 164 | ; = "3C", returns city = "3S", state = "3Z", zip
|
---|
| 165 | ; IBSFD (optional) = Output formatter segment name if the output needs
|
---|
| 166 | ; to be screened thru the VAMCFD^IBCEF75 procedure for the flag
|
---|
| 167 | ; in the insurance company file
|
---|
| 168 | ;
|
---|
| 169 | N Z,IBX,IBZ
|
---|
| 170 | S IBX=""
|
---|
| 171 | ;
|
---|
| 172 | I $G(IBSFD)="SUB" D VAMCFD^IBCEF75(+$G(IBXIEN),.IBZ) I $D(IBZ),'$G(IBZ("C",1)) G GETFACX
|
---|
| 173 | ;
|
---|
| 174 | S Z=$S('IBFILE:$G(^DIC(4,+IB,1)),1:$G(^IBA(355.93,+IB,0)))
|
---|
| 175 | I +IBELE=0 S IBX=$S('IBFILE:$P($G(^DIC(4,+IB,0)),U),1:$P($G(^IBA(355.93,+IB,0)),U))
|
---|
| 176 | I IBELE=1!(IBELE=12) S IBX=$S('IBFILE:$P(Z,U),1:$P(Z,U,5))
|
---|
| 177 | I IBELE=2!(IBELE=12) S IBX=$S(IBELE=12:IBX_" ",1:"")_$S('IBFILE:$P(Z,U,2),1:$P(Z,U,10))
|
---|
| 178 | ;
|
---|
| 179 | I +IBELE=3,'IBFILE D
|
---|
| 180 | . S:IBELE=3!(IBELE["C") IBX=$P(Z,U,3) Q:IBELE["C"
|
---|
| 181 | . 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"
|
---|
| 182 | . S:IBELE=3 IBX=IBX_" " S:IBELE=3!(IBELE["Z") IBX=IBX_$P(Z,U,4)
|
---|
| 183 | . Q
|
---|
| 184 | ;
|
---|
| 185 | I +IBELE=3,IBFILE D
|
---|
| 186 | . S:IBELE=3!(IBELE["C") IBX=$P(Z,U,6) Q:IBELE["C"
|
---|
| 187 | . S:IBELE=3 IBX=IBX_$S(IBX'="":", ",1:"") S:IBELE=3!(IBELE["S") IBX=IBX_$$STATE^IBCEFG1($P(Z,U,7))
|
---|
| 188 | . S:IBELE=3 IBX=IBX_" " S:IBELE=3!(IBELE["Z") IBX=IBX_$P(Z,U,8)
|
---|
| 189 | . Q
|
---|
| 190 | GETFACX ;
|
---|
| 191 | Q IBX
|
---|
| 192 | ;
|
---|
| 193 | ALLID(IBPRV,IBPTYP,IBZ) ; Returns array IBZ for all ids for provider IBPRV
|
---|
| 194 | ; for all provider id types or for id type in IBPTYP
|
---|
| 195 | ; IBPRV = vp ien of provider
|
---|
| 196 | ; IBPTYP = ien of provider id type to return or "" for all
|
---|
| 197 | ; IBZ = array returned with internal data:
|
---|
| 198 | ; IBZ(file 355.9 ien)=ID type^ID#^ins co^form type^bill care type^care un^X12 code for id type
|
---|
| 199 | N Z,Z0
|
---|
| 200 | K IBZ
|
---|
| 201 | G:'$G(IBPRV) ALLIDQ
|
---|
| 202 | S IBPTYP=$G(IBPTYP)
|
---|
| 203 | S Z=0 F S Z=$O(^IBA(355.9,"B",IBPRV,Z)) Q:'Z S Z0=$G(^IBA(355.9,Z,0)) D
|
---|
| 204 | . 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)
|
---|
| 205 | ;
|
---|
| 206 | ALLIDQ Q
|
---|
| 207 | ;
|
---|
| 208 | CLIA() ; Returns ien of CLIA # provider id type
|
---|
| 209 | N Z,IBZ
|
---|
| 210 | 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
|
---|
| 211 | Q IBZ
|
---|
| 212 | ;
|
---|
| 213 | STLIC() ; Returns ien of STLIC# provider id type
|
---|
| 214 | N Z,IBZ
|
---|
| 215 | 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
|
---|
| 216 | Q IBZ
|
---|
| 217 | ;
|
---|
| 218 | TAXID() ; Returns ien of Fed tax id provider id type
|
---|
| 219 | N Z,IBZ
|
---|
| 220 | 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
|
---|
| 221 | Q IBZ
|
---|
| 222 | ;
|
---|
| 223 | CLIANVA(IBIFN) ; Returns CLIA # for a non-VA facility on bill ien IBIFN
|
---|
| 224 | N IBCLIA,IBZ,IBNVA,Z
|
---|
| 225 | S IBCLIA="",IBZ=$$CLIA()
|
---|
| 226 | I IBZ D
|
---|
| 227 | . S IBNVA=$P($G(^DGCR(399,IBIFN,"U2")),U,10) Q:'IBNVA
|
---|
| 228 | . S IBCLIA=$$IDFIND^IBCEP2(IBIFN,IBZ,IBNVA_";IBA(355.93,","",1)
|
---|
| 229 | Q IBCLIA
|
---|
| 230 | ;
|
---|
| 231 | VALFAC(X) ; Function returns 1 if format is valid for X12 facility name
|
---|
| 232 | ; Alpha/numeric/certain punctuation valid. Must start with an Alpha
|
---|
| 233 | N OK,VAL
|
---|
| 234 | S OK=1
|
---|
| 235 | S VAL("A")="",VAL("N")="",VAL=",.- "
|
---|
| 236 | I $E(X)'?1A!'$$VALFMT(X,.VAL) S OK=0
|
---|
| 237 | Q OK
|
---|
| 238 | ;
|
---|
| 239 | VALFMT(X,VAL) ; Returns 1 if format of X is valid, 0 if not
|
---|
| 240 | ; X = data to be examined
|
---|
| 241 | ; VAL = a 'string' of valid characters AND/OR (passed by reference)
|
---|
| 242 | ; if VAL("A") defined ==> Alpha
|
---|
| 243 | ; if VAL("A") defined ==> Numeric valid
|
---|
| 244 | ; if VAL("A") defined ==> Punctuation valid
|
---|
| 245 | ; any other character included in the string is checked individually
|
---|
| 246 | N Z
|
---|
| 247 | I $D(VAL("A")) D
|
---|
| 248 | . N Z0
|
---|
| 249 | . F Z=1:1:$L(X) I $E(X,Z)?1A S Z0(Z)=""
|
---|
| 250 | . S Z0="" F S Z0=$O(Z0(Z0),-1) Q:'Z0 S $E(X,Z0)=""
|
---|
| 251 | I $D(VAL("N")) D
|
---|
| 252 | . N Z0
|
---|
| 253 | . F Z=1:1:$L(X) I $E(X,Z)?1N S Z0(Z)=""
|
---|
| 254 | . S Z0="" F S Z0=$O(Z0(Z0),-1) Q:'Z0 S $E(X,Z0)=""
|
---|
| 255 | I $D(VAL("P")) D
|
---|
| 256 | . N Z0
|
---|
| 257 | . F Z=1:1:$L(X) I $E(X,Z)?1P S Z0(Z)=""
|
---|
| 258 | . S Z0="" F S Z0=$O(Z0(Z0),-1) Q:'Z0 S $E(X,Z0)=""
|
---|
| 259 | I $G(VAL)'="" S X=$TR(X,VAL,"")
|
---|
| 260 | Q (X="")
|
---|
| 261 | ;
|
---|
| 262 | PS(IBXSAVE) ; Returns 1 if IBXSAVE("PSVC") indicates the svc was non-lab
|
---|
| 263 | ;
|
---|
| 264 | Q $S($G(IBXSAVE("PSVC"))="":0,1:"13"[IBXSAVE("PSVC"))
|
---|
| 265 | ;
|
---|
| 266 | ; Pass in the Internal Entry number to File 355.93
|
---|
| 267 | ; Return the Primary ID and Qualifier (ID Type) from 355.9
|
---|
| 268 | PRIMID(IEN35593) ; Return External Primary ID and ID Quailier
|
---|
| 269 | N INDXVAL,LIST,MSG,IDCODE
|
---|
| 270 | S INDXVAL=IEN35593_";IBA(355.93,"
|
---|
| 271 | N SCREEN S SCREEN="I $P(^(0),U,8)"
|
---|
| 272 | D FIND^DIC(355.9,,"@;.06EI;.07","Q",INDXVAL,,,SCREEN,,"LIST","MSG")
|
---|
| 273 | I '+$G(LIST("DILIST",0)) Q "" ; No Primary ID
|
---|
| 274 | I +$G(LIST("DILIST",0))>1 Q "***ERROR***^***ERROR***" ; Bad. More than one.
|
---|
| 275 | ; Found just one
|
---|
| 276 | S IDCODE=$$GET1^DIQ(355.97,LIST("DILIST","ID",1,.06,"I"),.03)
|
---|
| 277 | Q $G(LIST("DILIST","ID",1,.07))_U_IDCODE_" - "_$G(LIST("DILIST","ID",1,.06,"E"))
|
---|