iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improvements to RNF format routines. FILE2CSV^C0CRNF to export files to csv

This commit is contained in:
george 2008-12-14 19:35:31 +00:00
parent 68fc454a17
commit ef1ec0a366
3 changed files with 111 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
p/C0CDIC.m
View File

@ -121,7 +121,7 @@ INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
F S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0 D ; FOR EACH DICT ENTRY
. ;W C0CZX,!
. K C0CA,C0CN ; CLEAR OUT THE LAST ONE
. D GETN^C0CRNF("C0CA",170,C0CZX,"ALL") ; GET VARIABLE HASH
. D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
. ;ZWR C0CA B ;
. S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
. W "VARIABLE: ",C0CN,!

101
p/C0CRNF.m
View File

@ -42,7 +42,7 @@ FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
. S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
Q
;
GETN(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
; GRTN IS PASSED BY NAME
;
N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
@ -68,7 +68,7 @@ GETN(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
Q
;
GETN2(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
@ -120,28 +120,114 @@ GETN2(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
Q
;
GETALL(GARTN,GAFILE,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
; .. FIELD MAP @GARTN@("F","FIELDNAME^FILE^FIELD#")=""
; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME")=VALUE
; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
; .. OF THE FILE WILL BE USED
; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
N GATMP,GAI,GAF
;N GATMP,GAI,GAF
S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
I '$D(GAIDX) S GAIDX="" ;DEFAULT
I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
W GAF,!
W $O(@GAF@(0)) ;
S GAI=0 ;ITERATOR
; F S GAI=$O(@GAF@
F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
. D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
. N GAX S GAX=0
. F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
. . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
Q
;
ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
;
S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
Q
;
RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
; RNSTY IS STYLE OF THE OUTPUT -
; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
N RNR,RNC ;ROW ROOT,COL ROOT
N RNI,RNJ,RNX
I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
E D VN(RNRTN,RNIN) ;
Q
;
NV(RNRTN,RNIN) ;
S RNR=$NA(@RNIN@("F"))
S RNC=$NA(@RNIN@("V"))
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
S RNI=""
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
S RNI=""
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
. S RNJ=""
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
. . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN
. . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
. . E S RNX=RNX_"," ; NUL COLUMN
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
. D PUSH^GPLXPATH(RNRTN,RNX)
Q
;
VN(RNRTN,RNIN) ;
S RNR=$NA(@RNIN@("V"))
S RNC=$NA(@RNIN@("F"))
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
S RNI=""
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
S RNI=""
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
. S RNJ=""
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
. . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
. . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
. . E S RNX=RNX_"," ; NUL COLUMN
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
. D PUSH^GPLXPATH(RNRTN,RNX)
Q
;
FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
;
;N G1,G2
I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
S G1=$NA(^TMP($J,"C0CCSV",1))
S G2=$NA(^TMP($J,"C0CCSV",2))
D GETN2(G1,FNUM) ; GET THE MATRIX
D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
K @G1
W $$OUTPUT^GPLXPATH(@G2@(1),"FILE_"_FNUM_".csv",^TMP("GPLCCR","ODIR"))
K @G2
Q
;
FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
@ -149,6 +235,7 @@ FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
N C0CF
S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
I C0CF["()" S C0CF=$P(C0CF,"()",1)
Q C0CF
;
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED

32
p/C0CRXN.m
View File

@ -42,7 +42,7 @@ EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD
. K C0CA,C0CB,C0CC ; CLEAR ARRAYS
. D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE
. D GETN2^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS
. D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS
. I $$ZVALUE("MEDIATION CODE")="" D
. . S NORXN=NORXN+1 ;
. E D ; PROCESS MEDIATION CODE
@ -53,7 +53,7 @@ EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
. . ;ZWR C0CA
. D GETN2^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
. . S RXFOUND=RXFOUND+1
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
@ -85,7 +85,7 @@ EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
; THE UMLS RXNORM DATABASE
; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED
; IN THE FILE BUT NO FLAGS ARE SET
; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N
@ -94,9 +94,9 @@ EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
; CODE IS MISSING IN THAT FILE, VARXN=N
; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS
; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING
; RXNORM TEXT=RXNORM TEXT STRING
; RXNORM TEXT=RXNORM TEXT STRING
; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID
; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
@ -111,9 +111,9 @@ EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
. D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
. D GETN2^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
. D GETN2^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
. D GETN2^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
. D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
. D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
. ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE
. D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE
. D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT
@ -133,7 +133,7 @@ EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
. . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH
. . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT
. . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N
. . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
. . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
. E D ;
. . D SETFDA("NDF","N") ;MARK AS MISSING
. . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT
@ -151,8 +151,8 @@ EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
; IN 176.114
; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
; IN 176.114
; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH
; ALSO CAPTURES THE RXNORM CODE MAPPING
; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX
@ -172,11 +172,11 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
. ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
. D GETN2^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
. D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
. I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN
. . S NOVUID=NOVUID+1 ; FLAG THE ERROR
. . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID
. D GETN2^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
. D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
. I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM
. . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM
. . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES
@ -187,7 +187,7 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
. . . W ZV,!
. . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH
. E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM
. D GETN2^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
. I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND
. . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!
. . S MISSING=MISSING+1
@ -198,7 +198,7 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
. . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF
. . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS
. . . W "VA: ",ZY,!
. . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
. . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
W "MISSING IN MAPPING FILE: ",MISSING,!
W "FOUND IN MAPPING FILE: ",FOUND,!
W "FOUND IN RXNORM: ",VMATCH,!
@ -216,7 +216,7 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
. . ;ZWR C0CA
. D GETN2^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
. . S RXFOUND=RXFOUND+1
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE