source: ccr/trunk/p/CCRVA200.m@ 300

Last change on this file since 300 was 122, checked in by George Lilly, 16 years ago

XINDEX fixes. almost clean except for long var names and big files
File size: 6.2 KB
Line 
1CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
2 ;;0.1;CCDCCR;;JUL 13, 2007;Build 0
3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 Q
20 ; This routine uses Kernel APIs and Direct Global Access to get
21 ; Proivder Data from File 200.
22 ;
23 ; The Global is VA(200,*)
24 ;
25FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
26 ; INPUT: DUZ (i.e. File 200 IEN) ByVal
27 ; OUTPUT: String
28 N NAME S NAME=$P(^VA(200,DUZ,0),U)
29 D NAMECOMP^XLFNAME(.NAME)
30 Q NAME("FAMILY")
31 ;
32GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
33 ; INPUT: DUZ ByVal
34 ; OUTPUT: String
35 N NAME S NAME=$P(^VA(200,DUZ,0),U)
36 D NAMECOMP^XLFNAME(.NAME)
37 Q NAME("GIVEN")
38 ;
39MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
40 ; INPUT: DUZ ByVal
41 ; OUTPUT: String
42 N NAME S NAME=$P(^VA(200,DUZ,0),U)
43 D NAMECOMP^XLFNAME(.NAME)
44 Q NAME("MIDDLE")
45 ;
46SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
47 ; INPUT: DUZ ByVal
48 ; OUTPUT: String
49 N NAME S NAME=$P(^VA(200,DUZ,0),U)
50 D NAMECOMP^XLFNAME(.NAME)
51 Q NAME("SUFFIX")
52 ;
53TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
54 ; INPUT: DUZ ByVal
55 ; OUTPUT: String
56 ; Gets External Value of Title field in New Person File.
57 ; It's actually a pointer to file 3.1
58 ; 200=New Person File; 8 is Title Field
59 Q $$GET1^DIQ(200,DUZ_",",8)
60 ;
61NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
62 ; INPUT: DUZ ByVal
63 ; OUTPUT: Delimited String in format:
64 ; IDType^ID^IDDescription
65 ; If the NPI doesn't exist, "" is returned.
66 ; This routine uses a call documented in the Kernel dev guide
67 ; This call returns as "NPI^TimeEntered^ActiveInactive"
68 ; It returns -1 for NPI if NPI doesn't exist.
69 N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
70 Q:NPI=-1 ""
71 Q "NPI^"_NPI_"^HHS"
72 ;
73SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
74 ; INPUT: DUZ ByVal
75 ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
76 ; Uses a Kernel API. Returns -1 if a specialty is not specified
77 ; in file 200.
78 ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
79 N STR S STR=$$GET^XUA4A72(DUZ)
80 Q:+STR<0 ""
81 ; Sometimes we have 3 pieces, or 2. Deal with that.
82 Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
83 Q $P(STR,U,2)_"-"_$P(STR,U,3)
84 ;
85ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
86 ; INPUT: DUZ, but not needed really... here for future expansion
87 ; OUTPUT: At this point "Work"
88 Q "Work"
89 ;
90ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
91 ; INPUT: DUZ ByVal
92 ; Output: String.
93 ;
94 ; First, get site number from the institution file.
95 ; 1st piece returned by $$SITE^VASITE, which gets the system institution
96 N INST S INST=$P($$SITE^VASITE(),U)
97 ;
98 ; Second, get mailing address
99 ; There are two APIs to get the address, one for physical and one for
100 ; mailing. We will check if mailing exists first, since that's the
101 ; one we want to use; then check for physical. If neither exists,
102 ; then we return nothing. We check for the existence of an address
103 ; by the length of the returned string.
104 ; NOTE: API doesn't support Address 2, so I won't even include it
105 ; in the template.
106 N ADD
107 S ADD=$$MADD^XUAF4(INST) ; mailing address
108 Q:$L(ADD) $P(ADD,U)
109 S ADD=$$PADD^XUAF4(INST) ; physical address
110 Q:$L(ADD) $P(ADD,U)
111 Q ""
112 ;
113CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
114 ; INPUT: DUZ ByVal
115 ; Output: String.
116 ; See ADD1 for comments
117 N INST S INST=$P($$SITE^VASITE(),U)
118 N ADD
119 S ADD=$$MADD^XUAF4(INST) ; mailing address
120 Q:$L(ADD) $P(ADD,U,2)
121 S ADD=$$PADD^XUAF4(INST) ; physical address
122 Q:$L(ADD) $P(ADD,U,2)
123 Q ""
124 ;
125STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
126 ; INPUT: DUZ ByVal
127 ; Output: String.
128 ; See ADD1 for comments
129 N INST S INST=$P($$SITE^VASITE(),U)
130 N ADD
131 S ADD=$$MADD^XUAF4(INST) ; mailing address
132 Q:$L(ADD) $P(ADD,U,3)
133 S ADD=$$PADD^XUAF4(INST) ; physical address
134 Q:$L(ADD) $P(ADD,U,3)
135 Q ""
136 ;
137POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
138 ; INPUT: DUZ ByVal
139 ; OUTPUT: String.
140 ; See ADD1 for comments
141 N INST S INST=$P($$SITE^VASITE(),U)
142 N ADD
143 S ADD=$$MADD^XUAF4(INST) ; mailing address
144 Q:$L(ADD) $P(ADD,U,4)
145 S ADD=$$PADD^XUAF4(INST) ; physical address
146 Q:$L(ADD) $P(ADD,U,4)
147 Q ""
148 ;
149TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
150 ; INPUT: DUZ ByVal
151 ; OUTPUT: String.
152 ; Direct global access
153 N TEL S TEL=$G(^VA(200,DUZ,.13))
154 Q $P(TEL,U,2)
155 ;
156TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
157 ; INPUT: DUZ ByVal
158 ; OUTPUT: String.
159 Q "Office"
160 ;
161EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
162 ; INPUT: DUZ ByVal
163 ; OUTPUT: String
164 ; Direct global access
165 N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
166 Q $P(EMAIL,U)
167 ;
Note: See TracBrowser for help on using the repository browser.