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

Last change on this file since 66 was 66, checked in by Sam Habiel, 16 years ago

Updated to a working CCRVA200 file

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