Changeset 69 for ccr/trunk/p/CCRVA200.m
- Timestamp:
- Jul 17, 2008, 3:55:07 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRVA200.m
r66 r69 1 1 CCRVA200 ;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. 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. 6 22 7 23 ; The Global is VA(200,*) 8 24 9 25 FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC 10 11 12 13 14 15 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 ; 16 32 GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC 17 18 19 20 21 22 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 ; 23 39 MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC 24 25 26 27 28 29 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 ; 30 46 SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC 31 32 33 34 35 36 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 ; 37 53 TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC 38 39 40 41 42 43 44 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 ; 45 61 NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC 46 47 48 ;IDType^ID^IDDescription49 50 51 52 53 54 55 56 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 ; 57 73 SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC 58 59 60 61 ;in file 200.62 63 64 65 66 67 68 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 ; 69 85 ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC 70 71 72 73 86 ; INPUT: DUZ, but not needed really... here for future expansion 87 ; OUTPUT: At this point "Work" 88 Q "Work" 89 ; 74 90 ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC 75 76 91 ; INPUT: DUZ ByVal 92 ; Output: String. 77 93 78 79 80 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) 81 97 82 83 ; There are two APIs to get the address, one for physical and one for 84 85 86 87 88 89 90 N ADD 91 92 93 94 95 96 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 ; 97 113 CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC 98 99 100 101 102 N ADD 103 104 105 106 107 108 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 ; 109 125 STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC 110 111 112 113 114 N ADD 115 116 117 118 119 120 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 ; 121 137 POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC 122 123 124 125 126 N ADD 127 128 129 130 131 132 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 ; 133 149 TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC 134 135 136 137 138 139 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 ; 140 156 TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC 141 142 143 144 157 ; INPUT: DUZ ByVal 158 ; OUTPUT: String. 159 Q "Office" 160 ; 145 161 EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC 146 147 148 149 150 151 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 ; 152 168
Note:
See TracChangeset
for help on using the changeset viewer.