VistA-ccr/p/C0CVA200.m

C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
        ;;0.1;C0C;;JUL 13, 2007;Build 0
 ;Copyright 2008 Sam Habiel.  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.
        ;
        ; The Global is VA(200,*)
        ;
FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
        ; 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")
        ;
GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String
        N NAME S NAME=$P(^VA(200,DUZ,0),U)
        D NAMECOMP^XLFNAME(.NAME)
        Q NAME("GIVEN")
        ;
MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String
        N NAME S NAME=$P(^VA(200,DUZ,0),U)
        D NAMECOMP^XLFNAME(.NAME)
        Q NAME("MIDDLE")
        ;
SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String
        N NAME S NAME=$P(^VA(200,DUZ,0),U)
        D NAMECOMP^XLFNAME(.NAME)
        Q NAME("SUFFIX")
        ;
TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
        ; 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)
        ;
NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
        ; 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"
        ;
SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
        ; Uses a Kernel API. Returns -1 if a specialty is not specified
        ;       in file 200.
        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
        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)
        ;
ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
        ; INPUT: DUZ, but not needed really... here for future expansion
        ; OUTPUT: At this point "Work"
        Q "Work"
        ;
ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
        ; INPUT: DUZ ByVal
        ; Output: String.
        ;
        ; 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)
        ;
        ; 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 ""
        ;
CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
	   ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 
        ; 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 ""
        ;
STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
        ; 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 ""
        ;
POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
        ; 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 ""
        ;
TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String.
        ; Direct global access
        N TEL S TEL=$G(^VA(200,DUZ,.13))
        Q $P(TEL,U,2)
        ;
TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String.
        Q "Office"
        ;
EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
        ; INPUT: DUZ ByVal
        ; OUTPUT: String
        ; Direct global access
        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
        Q $P(EMAIL,U)
        ;