2008-07-14 01:20:55 -04:00
|
|
|
|
CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
|
2008-07-17 15:55:07 -04:00
|
|
|
|
;;0.1;CCDCCR;;JUL 13, 2007;Build 0
|
|
|
|
|
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|
|
|
|
;General Public License See attached copy of the License.
|
|
|
|
|
;
|
|
|
|
|
;This program is free software; you can redistribute it and/or modify
|
|
|
|
|
;it under the terms of the GNU General Public License as published by
|
|
|
|
|
;the Free Software Foundation; either version 2 of the License, or
|
|
|
|
|
;(at your option) any later version.
|
|
|
|
|
;
|
|
|
|
|
;This program is distributed in the hope that it will be useful,
|
|
|
|
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;GNU General Public License for more details.
|
|
|
|
|
;
|
|
|
|
|
;You should have received a copy of the GNU General Public License along
|
|
|
|
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
|
|
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
|
|
|
Q
|
|
|
|
|
; This routine uses Kernel APIs and Direct Global Access to get
|
|
|
|
|
; Proivder Data from File 200.
|
2008-08-30 15:13:15 -04:00
|
|
|
|
;
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; The Global is VA(200,*)
|
2008-08-30 15:13:15 -04:00
|
|
|
|
;
|
2008-07-14 01:20:55 -04:00
|
|
|
|
FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ (i.e. File 200 IEN) ByVal
|
|
|
|
|
; OUTPUT: String
|
|
|
|
|
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("FAMILY")
|
|
|
|
|
;
|
2008-07-14 01:20:55 -04:00
|
|
|
|
GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String
|
|
|
|
|
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("GIVEN")
|
|
|
|
|
;
|
2008-07-14 01:20:55 -04:00
|
|
|
|
MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String
|
|
|
|
|
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("MIDDLE")
|
|
|
|
|
;
|
2008-07-14 01:20:55 -04:00
|
|
|
|
SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String
|
|
|
|
|
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("SUFFIX")
|
|
|
|
|
;
|
2008-07-14 01:20:55 -04:00
|
|
|
|
TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String
|
|
|
|
|
; Gets External Value of Title field in New Person File.
|
|
|
|
|
; It's actually a pointer to file 3.1
|
|
|
|
|
; 200=New Person File; 8 is Title Field
|
|
|
|
|
Q $$GET1^DIQ(200,DUZ_",",8)
|
|
|
|
|
;
|
2008-07-15 00:03:50 -04:00
|
|
|
|
NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: Delimited String in format:
|
|
|
|
|
; IDType^ID^IDDescription
|
|
|
|
|
; If the NPI doesn't exist, "" is returned.
|
|
|
|
|
; This routine uses a call documented in the Kernel dev guide
|
|
|
|
|
; This call returns as "NPI^TimeEntered^ActiveInactive"
|
|
|
|
|
; It returns -1 for NPI if NPI doesn't exist.
|
|
|
|
|
N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
|
|
|
|
|
Q:NPI=-1 ""
|
|
|
|
|
Q "NPI^"_NPI_"^HHS"
|
|
|
|
|
;
|
2008-07-15 00:03:50 -04:00
|
|
|
|
SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
|
|
|
|
|
; Uses a Kernel API. Returns -1 if a specialty is not specified
|
|
|
|
|
; in file 200.
|
2008-08-30 15:13:15 -04:00
|
|
|
|
; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code
|
2008-07-17 15:55:07 -04:00
|
|
|
|
N STR S STR=$$GET^XUA4A72(DUZ)
|
|
|
|
|
Q:+STR<0 ""
|
|
|
|
|
; Sometimes we have 3 pieces, or 2. Deal with that.
|
|
|
|
|
Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
|
|
|
|
|
Q $P(STR,U,2)_"-"_$P(STR,U,3)
|
|
|
|
|
;
|
2008-07-15 00:03:50 -04:00
|
|
|
|
ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ, but not needed really... here for future expansion
|
|
|
|
|
; OUTPUT: At this point "Work"
|
|
|
|
|
Q "Work"
|
|
|
|
|
;
|
2009-01-05 16:33:43 -05:00
|
|
|
|
ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; Output: String.
|
2008-08-30 15:13:15 -04:00
|
|
|
|
;
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; First, get site number from the institution file.
|
|
|
|
|
; 1st piece returned by $$SITE^VASITE, which gets the system institution
|
|
|
|
|
N INST S INST=$P($$SITE^VASITE(),U)
|
2008-08-30 15:13:15 -04:00
|
|
|
|
;
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; Second, get mailing address
|
|
|
|
|
; There are two APIs to get the address, one for physical and one for
|
|
|
|
|
; mailing. We will check if mailing exists first, since that's the
|
|
|
|
|
; one we want to use; then check for physical. If neither exists,
|
|
|
|
|
; then we return nothing. We check for the existence of an address
|
|
|
|
|
; by the length of the returned string.
|
|
|
|
|
; NOTE: API doesn't support Address 2, so I won't even include it
|
|
|
|
|
; in the template.
|
|
|
|
|
N ADD
|
|
|
|
|
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U)
|
|
|
|
|
S ADD=$$PADD^XUAF4(INST) ; physical address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U)
|
|
|
|
|
Q ""
|
|
|
|
|
;
|
2009-01-05 16:33:43 -05:00
|
|
|
|
CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
|
|
|
|
|
;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; Output: String.
|
|
|
|
|
; See ADD1 for comments
|
|
|
|
|
N INST S INST=$P($$SITE^VASITE(),U)
|
|
|
|
|
N ADD
|
|
|
|
|
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U,2)
|
|
|
|
|
S ADD=$$PADD^XUAF4(INST) ; physical address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U,2)
|
|
|
|
|
Q ""
|
|
|
|
|
;
|
2009-01-05 16:33:43 -05:00
|
|
|
|
STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; Output: String.
|
|
|
|
|
; See ADD1 for comments
|
|
|
|
|
N INST S INST=$P($$SITE^VASITE(),U)
|
|
|
|
|
N ADD
|
|
|
|
|
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U,3)
|
|
|
|
|
S ADD=$$PADD^XUAF4(INST) ; physical address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U,3)
|
|
|
|
|
Q ""
|
|
|
|
|
;
|
2009-01-05 16:33:43 -05:00
|
|
|
|
POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String.
|
|
|
|
|
; See ADD1 for comments
|
|
|
|
|
N INST S INST=$P($$SITE^VASITE(),U)
|
|
|
|
|
N ADD
|
|
|
|
|
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U,4)
|
|
|
|
|
S ADD=$$PADD^XUAF4(INST) ; physical address
|
|
|
|
|
Q:$L(ADD) $P(ADD,U,4)
|
|
|
|
|
Q ""
|
|
|
|
|
;
|
2008-07-17 00:01:47 -04:00
|
|
|
|
TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String.
|
|
|
|
|
; Direct global access
|
|
|
|
|
N TEL S TEL=$G(^VA(200,DUZ,.13))
|
|
|
|
|
Q $P(TEL,U,2)
|
|
|
|
|
;
|
2008-07-17 00:01:47 -04:00
|
|
|
|
TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String.
|
|
|
|
|
Q "Office"
|
|
|
|
|
;
|
2008-07-17 00:01:47 -04:00
|
|
|
|
EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
|
2008-07-17 15:55:07 -04:00
|
|
|
|
; INPUT: DUZ ByVal
|
|
|
|
|
; OUTPUT: String
|
|
|
|
|
; Direct global access
|
|
|
|
|
N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
|
|
|
|
|
Q $P(EMAIL,U)
|
|
|
|
|
;
|