source: ccr/trunk/p/C0CVA200.m

Last change on this file was 1586, checked in by Sam Habiel, 12 years ago

Changed license to AGPL. Some clean-up for XINDEX

  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CVA200.m1290
    /ccr/branches/ohum/p/C0CVA200.m1291-1543
    /ccr/branches/ohum/p/p/C0CVA200.m1287-1289
File size: 5.4 KB
Line 
1C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
3 ;Copyright 2008 Sam Habiel.
4 ;
5 ; This program is free software: you can redistribute it and/or modify
6 ; it under the terms of the GNU Affero General Public License as
7 ; published by the Free Software Foundation, either version 3 of the
8 ; License, or (at your option) any later version.
9 ;
10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU Affero General Public License for more details.
14 ;
15 ; You should have received a copy of the GNU Affero General Public License
16 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
17 ;
18 Q
19 ; This routine uses Kernel APIs and Direct Global Access to get
20 ; Proivder Data from File 200.
21 ;
22 ; The Global is VA(200,*)
23 ;
24FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
25 ; INPUT: DUZ (i.e. File 200 IEN) ByVal
26 ; OUTPUT: String
27 N NAME S NAME=$P(^VA(200,DUZ,0),U)
28 D NAMECOMP^XLFNAME(.NAME)
29 Q NAME("FAMILY")
30 ;
31GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
32 ; INPUT: DUZ ByVal
33 ; OUTPUT: String
34 N NAME S NAME=$P(^VA(200,DUZ,0),U)
35 D NAMECOMP^XLFNAME(.NAME)
36 Q NAME("GIVEN")
37 ;
38MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
39 ; INPUT: DUZ ByVal
40 ; OUTPUT: String
41 N NAME S NAME=$P(^VA(200,DUZ,0),U)
42 D NAMECOMP^XLFNAME(.NAME)
43 Q NAME("MIDDLE")
44 ;
45SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
46 ; INPUT: DUZ ByVal
47 ; OUTPUT: String
48 N NAME S NAME=$P(^VA(200,DUZ,0),U)
49 D NAMECOMP^XLFNAME(.NAME)
50 Q NAME("SUFFIX")
51 ;
52TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
53 ; INPUT: DUZ ByVal
54 ; OUTPUT: String
55 ; Gets External Value of Title field in New Person File.
56 ; It's actually a pointer to file 3.1
57 ; 200=New Person File; 8 is Title Field
58 Q $$GET1^DIQ(200,DUZ_",",8)
59 ;
60NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
61 ; INPUT: DUZ ByVal
62 ; OUTPUT: Delimited String in format:
63 ; IDType^ID^IDDescription
64 ; If the NPI doesn't exist, "" is returned.
65 ; This routine uses a call documented in the Kernel dev guide
66 ; This call returns as "NPI^TimeEntered^ActiveInactive"
67 ; It returns -1 for NPI if NPI doesn't exist.
68 N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
69 Q:NPI=-1 ""
70 Q "NPI^"_NPI_"^HHS"
71 ;
72SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
73 ; INPUT: DUZ ByVal
74 ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
75 ; Uses a Kernel API. Returns -1 if a specialty is not specified
76 ; in file 200.
77 ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
78 N STR S STR=$$GET^XUA4A72(DUZ)
79 Q:+STR<0 ""
80 ; Sometimes we have 3 pieces, or 2. Deal with that.
81 Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
82 Q $P(STR,U,2)_"-"_$P(STR,U,3)
83 ;
84ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
85 ; INPUT: DUZ, but not needed really... here for future expansion
86 ; OUTPUT: At this point "Work"
87 Q "Work"
88 ;
89ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
90 ; INPUT: DUZ ByVal
91 ; Output: String.
92 ;
93 ; First, get site number from the institution file.
94 ; 1st piece returned by $$SITE^VASITE, which gets the system institution
95 N INST S INST=$P($$SITE^VASITE(),U)
96 ;
97 ; Second, get mailing address
98 ; There are two APIs to get the address, one for physical and one for
99 ; mailing. We will check if mailing exists first, since that's the
100 ; one we want to use; then check for physical. If neither exists,
101 ; then we return nothing. We check for the existence of an address
102 ; by the length of the returned string.
103 ; NOTE: API doesn't support Address 2, so I won't even include it
104 ; in the template.
105 N ADD
106 S ADD=$$MADD^XUAF4(INST) ; mailing address
107 Q:$L(ADD) $P(ADD,U)
108 S ADD=$$PADD^XUAF4(INST) ; physical address
109 Q:$L(ADD) $P(ADD,U)
110 Q ""
111 ;
112CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
113 ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING
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(ADUZ) ; 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(ADUZ) ; 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.