Changeset 307 for ccr/trunk/p
- Timestamp:
- Dec 14, 2008, 2:35:31 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CDIC.m
r301 r307 122 122 . ;W C0CZX,! 123 123 . K C0CA,C0CN ; CLEAR OUT THE LAST ONE 124 . D GETN ^C0CRNF("C0CA",170,C0CZX,"ALL") ; GET VARIABLE HASH124 . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH 125 125 . ;ZWR C0CA B ; 126 126 . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE -
ccr/trunk/p/C0CRNF.m
r304 r307 43 43 Q 44 44 ; 45 GETN (GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME45 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME 46 46 ; GRTN IS PASSED BY NAME 47 47 ; … … 69 69 Q 70 70 ; 71 GETN 2(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP71 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 72 72 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 73 73 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP … … 121 121 Q 122 122 ; 123 GET ALL(GARTN,GAFILE,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES123 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES 124 124 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 125 ; .. FIELD MAP @GARTN@("F","FIELDNAME ^FILE^FIELD#")=""125 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#" 126 126 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 127 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME")=VALUE 127 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE 128 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES 128 129 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 129 130 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP … … 131 132 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 132 133 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE 134 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN 135 ; .. OF THE FILE WILL BE USED 133 136 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE 134 137 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED … … 137 140 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 138 141 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL 139 N GATMP,GAI,GAF142 ;N GATMP,GAI,GAF 140 143 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE 144 I '$D(GAIDX) S GAIDX="" ;DEFAULT 145 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED 146 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX 141 147 W GAF,! 142 148 W $O(@GAF@(0)) ; 143 149 S GAI=0 ;ITERATOR 144 ; F S GAI=$O(@GAF@ 150 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ; 151 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD 152 . N GAX S GAX=0 153 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS 154 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN 155 Q 156 ; 157 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX 158 ; 159 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD# 160 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE 161 Q 162 ; 163 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT 164 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES 165 ; RNSTY IS STYLE OF THE OUTPUT - 166 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES 167 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES 168 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES 169 N RNR,RNC ;ROW ROOT,COL ROOT 170 N RNI,RNJ,RNX 171 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT 172 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION 173 E D VN(RNRTN,RNIN) ; 174 Q 175 ; 176 NV(RNRTN,RNIN) ; 177 S RNR=$NA(@RNIN@("F")) 178 S RNC=$NA(@RNIN@("V")) 179 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 180 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 181 S RNI="" 182 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 183 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 184 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 185 D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 186 S RNI="" 187 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 188 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 189 . S RNJ="" 190 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 191 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN 192 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 193 . . E S RNX=RNX_"," ; NUL COLUMN 194 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 195 . D PUSH^GPLXPATH(RNRTN,RNX) 196 Q 197 ; 198 VN(RNRTN,RNIN) ; 199 S RNR=$NA(@RNIN@("V")) 200 S RNC=$NA(@RNIN@("F")) 201 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 202 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 203 S RNI="" 204 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 205 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 206 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 207 D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 208 S RNI="" 209 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 210 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 211 . S RNJ="" 212 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 213 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN 214 . . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 215 . . E S RNX=RNX_"," ; NUL COLUMN 216 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 217 . D PUSH^GPLXPATH(RNRTN,RNX) 218 Q 219 ; 220 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV 221 ; 222 ;N G1,G2 223 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE 224 S G1=$NA(^TMP($J,"C0CCSV",1)) 225 S G2=$NA(^TMP($J,"C0CCSV",2)) 226 D GETN2(G1,FNUM) ; GET THE MATRIX 227 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE 228 K @G1 229 W $$OUTPUT^GPLXPATH(@G2@(1),"FILE_"_FNUM_".csv",^TMP("GPLCCR","ODIR")) 230 K @G2 145 231 Q 146 232 ; … … 150 236 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE 151 237 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT 238 I C0CF["()" S C0CF=$P(C0CF,"()",1) 152 239 Q C0CF 153 240 ; -
ccr/trunk/p/C0CRXN.m
r306 r307 43 43 . K C0CA,C0CB,C0CC ; CLEAR ARRAYS 44 44 . D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE 45 . D GETN 2^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS45 . D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS 46 46 . I $$ZVALUE("MEDIATION CODE")="" D 47 47 . . S NORXN=NORXN+1 ; … … 54 54 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 55 55 . . ;ZWR C0CA 56 . D GETN 2^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")56 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 57 57 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND 58 58 . . S RXFOUND=RXFOUND+1 … … 86 86 ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST 87 87 ; THE UMLS RXNORM DATABASE 88 ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN 88 ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN 89 89 ; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED 90 90 ; IN THE FILE BUT NO FLAGS ARE SET … … 95 95 ; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS 96 96 ; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING 97 ; RXNORM TEXT=RXNORM TEXT STRING 97 ; RXNORM TEXT=RXNORM TEXT STRING 98 98 ; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID 99 ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE 99 ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE 100 100 ; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE 101 101 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR … … 112 112 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 113 113 . D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 114 . D GETN 2^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE115 . D GETN 2^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE116 . D GETN 2^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF114 . D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE 115 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE 116 . D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF 117 117 . ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE 118 118 . D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE … … 134 134 . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT 135 135 . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N 136 . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT 136 . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT 137 137 . E D ; 138 138 . . D SETFDA("NDF","N") ;MARK AS MISSING … … 152 152 ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68), 153 153 ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD 154 ; IN 176.114 155 ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE 154 ; IN 176.114 155 ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE 156 156 ; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH 157 157 ; ALSO CAPTURES THE RXNORM CODE MAPPING … … 173 173 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 174 174 . ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 175 . D GETN 2^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS175 . D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS 176 176 . I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN 177 177 . . S NOVUID=NOVUID+1 ; FLAG THE ERROR 178 178 . . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID 179 . D GETN 2^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB179 . D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB 180 180 . I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM 181 181 . . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM … … 188 188 . . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH 189 189 . E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM 190 . D GETN 2^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111190 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111 191 191 . I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND 192 192 . . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),! … … 199 199 . . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS 200 200 . . . W "VA: ",ZY,! 201 . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT 201 . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT 202 202 W "MISSING IN MAPPING FILE: ",MISSING,! 203 203 W "FOUND IN MAPPING FILE: ",FOUND,! … … 217 217 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 218 218 . . ;ZWR C0CA 219 . D GETN 2^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")219 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 220 220 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND 221 221 . . S RXFOUND=RXFOUND+1
Note:
See TracChangeset
for help on using the changeset viewer.
