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

Last change on this file since 1425 was 1336, checked in by George Lilly, 13 years ago

removed tabs
File size: 5.5 KB
Line 
1C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
2 ;;1.0;C0C;;May 19, 2009;Build 38
3 ;Copyright 2008 Sam Habiel. 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(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
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(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
114 ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING
115 ; INPUT: DUZ ByVal
116 ; Output: String.
117 ; See ADD1 for comments
118 N INST S INST=$P($$SITE^VASITE(),U)
119 N ADD
120 S ADD=$$MADD^XUAF4(INST) ; mailing address
121 Q:$L(ADD) $P(ADD,U,2)
122 S ADD=$$PADD^XUAF4(INST) ; physical address
123 Q:$L(ADD) $P(ADD,U,2)
124 Q ""
125 ;
126STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
127 ; INPUT: DUZ ByVal
128 ; Output: String.
129 ; See ADD1 for comments
130 N INST S INST=$P($$SITE^VASITE(),U)
131 N ADD
132 S ADD=$$MADD^XUAF4(INST) ; mailing address
133 Q:$L(ADD) $P(ADD,U,3)
134 S ADD=$$PADD^XUAF4(INST) ; physical address
135 Q:$L(ADD) $P(ADD,U,3)
136 Q ""
137 ;
138POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
139 ; INPUT: DUZ ByVal
140 ; OUTPUT: String.
141 ; See ADD1 for comments
142 N INST S INST=$P($$SITE^VASITE(),U)
143 N ADD
144 S ADD=$$MADD^XUAF4(INST) ; mailing address
145 Q:$L(ADD) $P(ADD,U,4)
146 S ADD=$$PADD^XUAF4(INST) ; physical address
147 Q:$L(ADD) $P(ADD,U,4)
148 Q ""
149 ;
150TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
151 ; INPUT: DUZ ByVal
152 ; OUTPUT: String.
153 ; Direct global access
154 N TEL S TEL=$G(^VA(200,DUZ,.13))
155 Q $P(TEL,U,2)
156 ;
157TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
158 ; INPUT: DUZ ByVal
159 ; OUTPUT: String.
160 Q "Office"
161 ;
162EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
163 ; INPUT: DUZ ByVal
164 ; OUTPUT: String
165 ; Direct global access
166 N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
167 Q $P(EMAIL,U)
168 ;
Note: See TracBrowser for help on using the repository browser.