source: ccr/trunk/p/C0CVA200.m@ 1582

C0CVA200        ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
        ;;1.2;C0C;;May 11, 2012;Build 47
        ;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)
         ;