Changeset 1337 for ccr/branches/ohum/p/C0CVA200.m

Timestamp:

Jan 4, 2012, 9:40:24 PM (13 years ago)

Author:

George Lilly

Message:

certification version without tabs

File:

• ccr/branches/ohum/p/C0CVA200.m (modified) (1 diff)

ccr/branches/ohum/p/C0CVA200.m

@@ -1 @@
-C0CVA200        ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
-        ;;1.0;C0C;;May 19, 2009;Build 1
-        ;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)
-         ;
+C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
+ ;;1.0;C0C;;May 19, 2009;Build 38
+ ;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)
+  ;