Changeset 1204 for ccr/trunk/p/C0CVA200.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CVA200.m
r508 r1204 1 1 C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 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 ; 25 25 FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC 26 27 28 29 30 31 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 ; 32 32 GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC 33 34 35 36 37 38 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 ; 39 39 MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC 40 41 42 43 44 45 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 ; 46 46 SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC 47 48 49 50 51 52 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 ; 53 53 TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC 54 55 56 57 58 59 60 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 ; 61 61 NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC 62 63 64 65 66 67 68 69 70 71 72 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 ; 73 73 SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC 74 75 76 77 78 79 80 81 82 83 84 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^Subspecialty^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 ; 85 85 ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC 86 87 88 89 86 ; INPUT: DUZ, but not needed really... here for future expansion 87 ; OUTPUT: At this point "Work" 88 Q "Work" 89 ; 90 90 ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 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 ; 113 113 CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC 114 115 116 117 118 119 120 121 122 123 124 125 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 ; 126 126 STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC 127 128 129 130 131 132 133 134 135 136 137 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 ; 138 138 POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC 139 140 141 142 143 144 145 146 147 148 149 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 ; 150 150 TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC 151 152 153 154 155 156 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 ; 157 157 TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC 158 159 160 161 158 ; INPUT: DUZ ByVal 159 ; OUTPUT: String. 160 Q "Office" 161 ; 162 162 EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC 163 164 165 166 167 168 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 TracChangeset
for help on using the changeset viewer.