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

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

added GPL license language
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 ;
168
Note: See TracBrowser for help on using the repository browser.