Changeset 1337 for ccr/branches/ohum/p/C0CRXN.m
- Timestamp:
- Jan 4, 2012, 9:40:24 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CRXN.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CRXN.m
r1333 r1337 1 C0CRXN 2 ;;1.0;C0C;;May 19, 2009;Build 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXPAND 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 EXP2 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 CHKNDF 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 SETFDA(C0CSN,C0CSV) 256 257 258 259 260 261 262 263 264 265 ZFILE(ZFN,ZTAB) 266 267 268 269 270 271 272 273 ZFIELD(ZFN,ZTAB) 274 275 276 277 278 279 280 281 282 ZVALUE(ZFN,ZTAB) 283 284 285 286 287 288 289 290 1 C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2009 George Lilly. 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 ; 20 W "This is the CCR RXNORM Utility Library ",! 21 W ! 22 Q 23 ; 24 EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112) 25 ; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM 26 ; CODE FROM 176.001 (RXNORM CONCEPTS) 27 ; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT 28 ; ALREADY HAVE AN RXNORM CODE. 29 ; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111) 30 ; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE 31 ; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES 32 ; USES SUPPORT ROUTINES FROM C0CRNF.m 33 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 34 N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES 35 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 36 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 37 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 38 S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSION FILE 39 W C0CVA,C0CFRXN,C0CF,! 40 S C0CZX=0 41 S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS 42 F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD 43 . K C0CA,C0CB,C0CC ; CLEAR ARRAYS 44 . D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE 45 . D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS 46 . I $$ZVALUE("MEDIATION CODE")="" D 47 . . S NORXN=NORXN+1 ; 48 . E D ; PROCESS MEDIATION CODE 49 . . S HASRXN=HASRXN+1 50 . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ; 51 . I $$ZVALUE("VUID")="" D ; BAD RECORD 52 . . S NOVUID=NOVUID+1 53 . . ;D SETFDA("VUID",$$ZVALUE("VUID")) 54 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 55 . . ;ZWR C0CA 56 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 57 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND 58 . . S RXFOUND=RXFOUND+1 59 . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE 60 . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB")) 61 . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM 62 . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),! 63 . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),! 64 . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1 65 . . E D ; 66 . . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB") 67 . . . D PUSH^GPLXPATH("NOMATCH",ZZ) 68 . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ; 69 . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT 70 . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ; 71 . . S RXMATCH=RXMATCH+1 72 . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),! 73 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 74 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD 75 . D UPDATE^DIE("","C0CFDA") 76 . I $D(^TMP("DIERR",$J)) U $P BREAK 77 W "HAS RXN=",HASRXN,! 78 W "NO RXN=",NORXN,! 79 W "NO VUID=",NOVUID,! 80 W "RXNORM FOUND=",RXFOUND,! 81 W "RXNORM MATCHES:",RXMATCH,! 82 W "TEXT MATCHES:",TXTMATCH,! 83 Q 84 ; 85 EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE 86 ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST 87 ; THE UMLS RXNORM DATABASE 88 ; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT 89 ; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF 90 ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN 91 ; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED 92 ; IN THE FILE BUT NO FLAGS ARE SET 93 ; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N 94 ; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT 95 ; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE 96 ; DRUG INGREDIENT FILE IS USED FOR COMPARISONS) 97 ; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N 98 ; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM 99 ; CODE IS MISSING IN THAT FILE, VARXN=N 100 ; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS 101 ; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING 102 ; RXNORM TEXT=RXNORM TEXT STRING 103 ; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID 104 ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE 105 ; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE 106 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 107 N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES 108 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 109 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 110 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 111 ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE 112 W C0CVA,C0CFRXN,! ;C0CF,! 113 S C0CZX=0 114 S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS 115 S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS 116 F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID 117 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 118 . D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 119 . D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE 120 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE 121 . D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF 122 . D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS 123 . ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE 124 . D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE 125 . D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT 126 . ;VA MAPPING FILE TESTS 127 . I $$ZVALUE("VUID","C0CB")=C0CZX D ; VUID FOUND 128 . . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT 129 . . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D ;TEXT MISMATCH 130 . . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT 131 . . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH 132 . . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT 133 . E D ; VUID NOT FOUND 134 . . S VANO=VANO+1 135 . . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE 136 . ; NATIONAL DRUG FILE TESTS 137 . I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D ; 138 . . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE 139 . . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT 140 . . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH 141 . . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D ;DRUG ING FILE ALSO 142 . . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT 143 . . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N 144 . . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT 145 . . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT 146 . E D ; 147 . . D SETFDA("NDF","N") ;MARK AS MISSING 148 . . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT 149 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 150 . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD 151 . D UPDATE^DIE("","C0CFDA") 152 . I $D(^TMP("DIERR",$J)) U $P BREAK 153 W "VA MAPPING VUID COUNT: ",VAVCNT,! 154 W "VA MAPPING MISSING: ",VANO,! 155 W "VA MAPPING TEXT MISMATCH: ",VATCNT,! 156 W "NDF VUID COUNT: ",NDFVCNT,! 157 W "NDF MISSING: ",NDFNO,! 158 W "NDF TEXT MISMATCH: ",NDFTCNT,! 159 Q 160 CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB 161 ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68), 162 ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD 163 ; IN 176.114 164 ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE 165 ; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH 166 ; ALSO CAPTURES THE RXNORM CODE MAPPING 167 ; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX 168 ; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT 169 ; SETS NOTMAPPED=Y 170 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 171 N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES 172 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 173 S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE 174 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 175 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 176 ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE 177 W C0CVA,C0CFRXN,! ;C0CF,! 178 S C0CZX=0 179 S (FOUND,MISSING)=0 180 S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS 181 F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID 182 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 183 . ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 184 . D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS 185 . I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN 186 . . S NOVUID=NOVUID+1 ; FLAG THE ERROR 187 . . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID 188 . D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB 189 . I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM 190 . . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM 191 . . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES 192 . . . S TXTMATCH=TXTMATCH+1 ; COUNT IT 193 . . E D ; TEXT DOESN'T MATCH 194 . . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER 195 . . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD") 196 . . . W ZV,! 197 . . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH 198 . E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM 199 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111 200 . I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND 201 . . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),! 202 . . S MISSING=MISSING+1 203 . . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE 204 . E D ; FOUND IN VA MAPPING FILE 205 . . S FOUND=FOUND+1 206 . . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D ; TEXT DOESN'T MATCH 207 . . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF 208 . . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS 209 . . . W "VA: ",ZY,! 210 . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT 211 W "MISSING IN MAPPING FILE: ",MISSING,! 212 W "FOUND IN MAPPING FILE: ",FOUND,! 213 W "FOUND IN RXNORM: ",VMATCH,! 214 W "NOT FOUND IN RXNORM: ",NOMATCH,! 215 W "ERRORS: ",NOVUID,! 216 Q 217 ; 218 . I $$ZVALUE("MEDIATION CODE")="" D 219 . . S NORXN=NORXN+1 ; 220 . E D ; PROCESS MEDIATION CODE 221 . . S HASRXN=HASRXN+1 222 . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ; 223 . I $$ZVALUE("VUID")="" D ; BAD RECORD 224 . . S NOVUID=NOVUID+1 225 . . ;D SETFDA("VUID",$$ZVALUE("VUID")) 226 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 227 . . ;ZWR C0CA 228 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 229 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND 230 . . S RXFOUND=RXFOUND+1 231 . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE 232 . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB")) 233 . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM 234 . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),! 235 . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),! 236 . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1 237 . . E D ; 238 . . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")) 239 . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ; 240 . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT 241 . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ; 242 . . S RXMATCH=RXMATCH+1 243 . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),! 244 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 245 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD 246 . D UPDATE^DIE("","C0CFDA") 247 . I $D(^TMP("DIERR",$J)) U $P BREAK 248 W "HAS RXN=",HASRXN,! 249 W "NO RXN=",NORXN,! 250 W "NO VUID=",NOVUID,! 251 W "RXNORM FOUND=",RXFOUND,! 252 W "RXNORM MATCHES:",RXMATCH,! 253 W "TEXT MATCHES:",TXTMATCH,! 254 Q 255 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 256 ; TO SET TO VALUE C0CSV. 257 ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 258 ; C0CSN,C0CSV ARE PASSED BY VALUE 259 ; 260 N C0CSI,C0CSJ 261 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 262 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 263 S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV 264 Q 265 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 266 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 267 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 268 I '$D(ZTAB) S ZTAB="C0CA" 269 N ZR 270 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 271 E S ZR="" 272 Q ZR 273 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 274 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 275 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 276 I '$D(ZTAB) S ZTAB="C0CA" 277 N ZR 278 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 279 E S ZR="" 280 Q ZR 281 ; 282 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 283 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 284 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 285 I '$D(ZTAB) S ZTAB="C0CA" 286 N ZR 287 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 288 E S ZR="" 289 Q ZR 290 ;
Note:
See TracChangeset
for help on using the changeset viewer.
