Changeset 1730 for ccr/trunk/rxnorm/trunk/routines/C0CRXNRD.m
- Timestamp:
- Apr 27, 2016, 7:02:22 PM (9 years ago)
- File:
-
- 1 edited
-
ccr/trunk/rxnorm/trunk/routines/C0CRXNRD.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/rxnorm/trunk/routines/C0CRXNRD.m
r1642 r1730 1 C0CRXNRD ; VEN/SMH - RxNorm Utilities: Routine to Read RxNorm files;2013-11-14 1:23 PM 2 ;;2.3;RXNORM FOR VISTA;;Jul 22, 2014;Build 10 3 ; (C) Sam Habiel 2013 4 ; See license for terms of use. 5 ; 6 W "No entry from top" Q 7 IMPORT(PATH,RESTRICTED) ; PUBLIC ENTRY POINT. Rest are private 8 I PATH="" QUIT 9 S RESTRICTED=$G(RESTRICTED,0) 10 S U="^" 11 N STARTTIME S STARTTIME=$P($H,",")*24*60*60+$P($H,",",2) 12 N SABS 13 D SAB(PATH,.SABS) ; Load restriction values into SAB. ; 176.006 14 D CONSO(PATH,.SABS,RESTRICTED),SAT(PATH,.SABS,RESTRICTED) ; 176.001,176.002 15 D STY(PATH),REL(PATH),DOC(PATH) ; 176.003-5 16 N ENDTIME S ENDTIME=$P($H,",")*24*60*60+$P($H,",",2) 17 W !,(ENDTIME-STARTTIME)/60_" minutes elapsed" 18 QUIT 19 ; 20 ; Everything is private from down on... 21 DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files 22 ; FN is Filenumber passed by Value 23 QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files 24 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root 25 N ZERO S ZERO=@ROOT@(0) ; Save zero node 26 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited 27 K @ROOT ; Kill the file -- so sad! 28 S @ROOT@(0)=ZERO ; It riseth again! 29 QUIT 30 GETLINES(PATH,FILENAME) ; Get number of lines in a file 31 N POP 32 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 33 Q:POP 34 U IO 35 N I,LINE 36 F I=1:1 R LINE:0 Q:$$STATUS^%ZISH 37 D CLOSE^%ZISH("FILE") 38 Q I-1 39 CONSO(PATH,SABS,RESTRICTED) ; Open and read concepts file: RXNCONSO.RRF 40 ; PATH ByVal, path of RxNorm files 41 ; SABS ByRef, arrays of SABS(SAB)=restriction level 42 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 43 I PATH="" QUIT 44 N FILENAME S FILENAME="RXNCONSO.RRF" 45 D DELFILED(176.001) ; delete data 46 N LINES S LINES=$$GETLINES(PATH,FILENAME) 47 N POP 48 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 49 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX 50 N C0CCOUNT 51 F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH 52 . U IO 53 . N LINE R LINE:0 54 . IF $$STATUS^%ZISH QUIT 55 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 56 . ; 57 . ; Deal with restriction level 58 . N SAB S SAB=$P(LINE,"|",12) 59 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 60 . ; 61 . ; Save data 62 . S ^C0CRXN(176.001,C0CCOUNT,0)=$TR(LINE,"|^","^|") 63 EX D CLOSE^%ZISH("FILE") 64 N DIK S DIK="^C0CRXN(176.001," D IXALL^DIK 65 QUIT 66 ; 67 ; 68 SAT(PATH,SABS,RESTRICTED) ; Open and read Concept and Atom attributes: RXNSAT.RRF 69 ; PATH ByVal, path of RxNorm files 70 ; SABS ByRef, arrays of SABS(SAB)=restriction level 71 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 72 I PATH="" QUIT 73 N FILENAME S FILENAME="RXNSAT.RRF" 74 D DELFILED(176.002) ; delete data 75 N LINES S LINES=$$GETLINES(PATH,FILENAME) 76 N POP 77 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 78 IF POP W "Error reading file..., Please check...",! G EX2 79 N C0CCOUNT F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D 80 . U IO 81 . N LINE R LINE:0 82 . IF $$STATUS^%ZISH QUIT 83 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 84 . ; 85 . ; We switch around the fields .01 and .09 because the .01 isn't always present; where as .09 is required 86 . N RXCUI1,ATN9 87 . S RXCUI1=$P(LINE,"|",1) 88 . S ATN9=$P(LINE,"|",9) 89 . S $P(LINE,"|",1)=ATN9 90 . S $P(LINE,"|",9)=RXCUI1 91 . ; 92 . ; Deal with restricted sources 93 . N SAB S SAB=$P(LINE,"|",10) 94 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 95 . ; 96 . ; Save off 97 . S ^C0CRXN(176.002,C0CCOUNT,0)=$TR(LINE,"|^","^|") 98 EX2 D CLOSE^%ZISH("FILE") 99 N DIK S DIK="^C0CRXN(176.002," D IXALL^DIK 100 QUIT 101 ; 102 ; 103 SAB(PATH,SABS) ; Open the read RxNorm Sources file: RXNSAB.RRF 104 I PATH="" QUIT 105 N FILENAME S FILENAME="RXNSAB.RRF" 106 D DELFILED(176.003) ; delete data 107 N POP 108 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 109 IF POP W "Error reading file..., Please check...",! G EX3 110 N I F I=1:1 Q:$$STATUS^%ZISH D 111 . U IO 112 . N LINE R LINE:0 113 . IF $$STATUS^%ZISH QUIT 114 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file 115 . ; Switch pieces 1 and 4 because 4 is always defined. Goes into .01 field. 116 . N VCUI S VCUI=$P(LINE,"|",1) 117 . N RSAB S RSAB=$P(LINE,"|",4) 118 . S $P(LINE,"|",1)=RSAB 119 . S $P(LINE,"|",4)=VCUI 120 . S ^C0CRXN(176.003,I,0)=$TR(LINE,"^|","|^") 121 EX3 D CLOSE^%ZISH("FILE") 122 N DIK S DIK="^C0CRXN(176.003," D IXALL^DIK 123 N C0CI F C0CI=0:0 S C0CI=$O(^C0CRXN(176.003,C0CI)) Q:'C0CI D 124 . S SABS($$GET1^DIQ(176.003,C0CI,.01))=$$GET1^DIQ(176.003,C0CI,"SRL") 125 QUIT 126 STY(PATH) ; Open and read RxNorm Semantic types file: RXNSTY.RRF 127 I PATH="" QUIT 128 N FILENAME S FILENAME="RXNSTY.RRF" 129 D DELFILED(176.004) ; delete data 130 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 131 N POP 132 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 133 IF POP W "Error reading file..., Please check...",! G EX4 134 N I F I=1:1 Q:$$STATUS^%ZISH D 135 . U IO 136 . N LINE R LINE:0 137 . IF $$STATUS^%ZISH QUIT 138 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 139 . S ^C0CRXN(176.004,I,0)=$TR(LINE,"^|","|^") 140 EX4 D CLOSE^%ZISH("FILE") 141 N DIK S DIK="^C0CRXN(176.004," D IXALL^DIK 142 QUIT 143 ; 144 REL(PATH) ; Open and read RxNorm Relationships file: RXNREL.RRF 145 I PATH="" QUIT 146 N FILENAME S FILENAME="RXNREL.RRF" 147 D DELFILED(176.005) ; delete data 148 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 149 N POP 150 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 151 IF POP W "Error reading file..., Please check...",! G EX5 152 N I F I=1:1 Q:$$STATUS^%ZISH D 153 . U IO 154 . N LINE R LINE:0 155 . IF $$STATUS^%ZISH QUIT 156 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 157 . ; swap RXCUI1 location with SAB b/c SAB is required so can be .01 field 158 . N RXCUI1 S RXCUI1=$P(LINE,"|",1) 159 . N SAB S SAB=$P(LINE,"|",11) 160 . S $P(LINE,"|",1)=SAB 161 . S $P(LINE,"|",11)=RXCUI1 162 . S ^C0CRXN(176.005,I,0)=$TR(LINE,"^|","|^") 163 EX5 D CLOSE^%ZISH("FILE") 164 N DIK S DIK="^C0CRXN(176.005," D IXALL^DIK 165 QUIT 166 DOC(PATH) ; Open the read RxNorm Abbreviation Documentation file: RXNDOC.RRF 167 I PATH="" QUIT 168 N FILENAME S FILENAME="RXNDOC.RRF" 169 D DELFILED(176.006) ; delete data 170 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 171 N POP 172 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 173 IF POP W "Error reading file..., Please check...",! G EX6 174 N I F I=1:1 Q:$$STATUS^%ZISH D 175 . U IO 176 . N LINE R LINE:0 177 . IF $$STATUS^%ZISH QUIT 178 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 179 . S ^C0CRXN(176.006,I,0)=$TR(LINE,"^|","|^") 180 EX6 D CLOSE^%ZISH("FILE") 181 N DIK S DIK="^C0CRXN(176.006," D IXALL^DIK 182 QUIT 1 C0CRXNRD ; VEN/SMH - RxNorm Utilities: Routine to Read RxNorm files;2013-11-14 1:23 PM 2 ;;2.5;RXNORM FOR VISTA;;Apr 27, 2016;Build 10 3 ; (C) Sam Habiel 2016 4 ; See license for terms of use. 5 ; 6 W "No entry from top" Q 7 IMPORT(PATH,RESTRICTED) ; PUBLIC ENTRY POINT. Rest are private 8 I PATH="" QUIT 9 S RESTRICTED=$G(RESTRICTED,0) 10 S U="^" 11 N STARTTIME S STARTTIME=$P($H,",")*24*60*60+$P($H,",",2) 12 D SAB(PATH) ; Load restriction values into SAB. ; 176.006 13 JOB SAT^C0CRXNRD(PATH,RESTRICTED) ; 176.002 14 W "Jobbed off... "_$ZJOB_"." 15 D CONSO(PATH,RESTRICTED) ; 176.001,176.002 16 D STY(PATH),REL(PATH),DOC(PATH) ; 176.003-5 17 N ENDTIME S ENDTIME=$P($H,",")*24*60*60+$P($H,",",2) 18 W !,(ENDTIME-STARTTIME)/60_" minutes elapsed" 19 QUIT 20 ; 21 ; Everything is private from down on... 22 DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files 23 ; FN is Filenumber passed by Value 24 QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files 25 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root 26 N ZERO S ZERO=@ROOT@(0) ; Save zero node 27 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited 28 K @ROOT ; Kill the file -- so sad! 29 S @ROOT@(0)=ZERO ; It riseth again! 30 QUIT 31 GETLINES(PATH,FILENAME) ; Get number of lines in a file 32 N POP 33 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 34 Q:POP 35 U IO 36 N I,LINE 37 F I=1:1 R LINE:0 Q:$$STATUS^%ZISH 38 D CLOSE^%ZISH("FILE") 39 Q I-1 40 CONSO(PATH,RESTRICTED) ; Open and read concepts file: RXNCONSO.RRF 41 ; PATH ByVal, path of RxNorm files 42 ; SABS ByRef, arrays of SABS(SAB)=restriction level 43 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 44 N SABS D LOADSABS(.SABS) 45 I PATH="" QUIT 46 N FILENAME S FILENAME="RXNCONSO.RRF" 47 D DELFILED(176.001) ; delete data 48 N LINES S LINES=$$GETLINES(PATH,FILENAME) 49 N POP 50 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 51 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX 52 N C0CCOUNT 53 N C0CSUPP S C0CSUPP=0 54 F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH 55 . U IO 56 . N LINE R LINE:0 57 . IF $$STATUS^%ZISH QUIT 58 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 59 . ; 60 . ; If suppressed, quit 61 . N SUPP S SUPP=$P(LINE,"|",17) 62 . I SUPP="O"!(SUPP="Y")!(SUPP="E") S C0CSUPP=C0CSUPP+1 QUIT 63 . ; 64 . ; Deal with restriction level 65 . N SAB S SAB=$P(LINE,"|",12) 66 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 67 . ; 68 . ; Save data 69 . S ^C0CRXN(176.001,C0CCOUNT,0)=$TR(LINE,"|^","^|") 70 EX D CLOSE^%ZISH("FILE") 71 N DIK S DIK="^C0CRXN(176.001," D IXALL^DIK 72 W "Suppressed: ",C0CSUPP,! 73 QUIT 74 ; 75 ; 76 SAT(PATH,RESTRICTED) ; Open and read Concept and Atom attributes: RXNSAT.RRF 77 ; PATH ByVal, path of RxNorm files 78 ; SABS ByRef, arrays of SABS(SAB)=restriction level 79 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 80 N $ET S $ET="D ^%ZTER HALT" 81 S U="^" 82 I PATH="" QUIT 83 N FILENAME S FILENAME="RXNSAT.RRF" 84 D DELFILED(176.002) ; delete data 85 N LINES S LINES=$$GETLINES(PATH,FILENAME) 86 N POP 87 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 88 IF POP W "Error reading file..., Please check...",! G EX2 89 N SABS D LOADSABS(.SABS) 90 N C0CSUPP S C0CSUPP=0 91 N C0CCOUNT F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D 92 . U IO 93 . N LINE R LINE:0 94 . IF $$STATUS^%ZISH QUIT 95 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 96 . ; 97 . ; If suppressed, quit 98 . N SUPP S SUPP=$P(LINE,"|",12) 99 . I SUPP="O"!(SUPP="Y")!(SUPP="E") S C0CSUPP=C0CSUPP+1 QUIT 100 . ; 101 . ; We switch around the fields .01 and .09 because the .01 isn't always present; where as .09 is required 102 . N RXCUI1,ATN9 103 . S RXCUI1=$P(LINE,"|",1) 104 . S ATN9=$P(LINE,"|",9) 105 . S $P(LINE,"|",1)=ATN9 106 . S $P(LINE,"|",9)=RXCUI1 107 . ; 108 . ; Deal with restricted sources 109 . N SAB S SAB=$P(LINE,"|",10) 110 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 111 . ; 112 . ; Save off 113 . S ^C0CRXN(176.002,C0CCOUNT,0)=$TR(LINE,"|^","^|") 114 EX2 D CLOSE^%ZISH("FILE") 115 N DIK S DIK="^C0CRXN(176.002," D IXALL^DIK 116 W "Suppressed: ",C0CSUPP,! 117 QUIT 118 ; 119 ; 120 SAB(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF 121 I PATH="" QUIT 122 N FILENAME S FILENAME="RXNSAB.RRF" 123 D DELFILED(176.003) ; delete data 124 N POP 125 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 126 IF POP W "Error reading file..., Please check...",! G EX3 127 N I F I=1:1 Q:$$STATUS^%ZISH D 128 . U IO 129 . N LINE R LINE:0 130 . IF $$STATUS^%ZISH QUIT 131 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file 132 . ; Switch pieces 1 and 4 because 4 is always defined. Goes into .01 field. 133 . N VCUI S VCUI=$P(LINE,"|",1) 134 . N RSAB S RSAB=$P(LINE,"|",4) 135 . S $P(LINE,"|",1)=RSAB 136 . S $P(LINE,"|",4)=VCUI 137 . S ^C0CRXN(176.003,I,0)=$TR(LINE,"^|","|^") 138 EX3 D CLOSE^%ZISH("FILE") 139 N DIK S DIK="^C0CRXN(176.003," D IXALL^DIK 140 QUIT 141 ; 142 LOADSABS(SABS) ; 143 N C0CI F C0CI=0:0 S C0CI=$O(^C0CRXN(176.003,C0CI)) Q:'C0CI D 144 . S SABS($$GET1^DIQ(176.003,C0CI,.01))=$$GET1^DIQ(176.003,C0CI,"SRL") 145 QUIT 146 ; 147 STY(PATH) ; Open and read RxNorm Semantic types file: RXNSTY.RRF 148 I PATH="" QUIT 149 N FILENAME S FILENAME="RXNSTY.RRF" 150 D DELFILED(176.004) ; delete data 151 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 152 N POP 153 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 154 IF POP W "Error reading file..., Please check...",! G EX4 155 N I F I=1:1 Q:$$STATUS^%ZISH D 156 . U IO 157 . N LINE R LINE:0 158 . IF $$STATUS^%ZISH QUIT 159 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 160 . S ^C0CRXN(176.004,I,0)=$TR(LINE,"^|","|^") 161 EX4 D CLOSE^%ZISH("FILE") 162 N DIK S DIK="^C0CRXN(176.004," D IXALL^DIK 163 QUIT 164 ; 165 REL(PATH) ; Open and read RxNorm Relationships file: RXNREL.RRF 166 I PATH="" QUIT 167 N FILENAME S FILENAME="RXNREL.RRF" 168 D DELFILED(176.005) ; delete data 169 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 170 N POP 171 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 172 IF POP W "Error reading file..., Please check...",! G EX5 173 N C0CSUPP S C0CSUPP=0 174 N I F I=1:1 Q:$$STATUS^%ZISH D 175 . U IO 176 . N LINE R LINE:0 177 . ; 178 . ; If suppressed, quit 179 . N SUPP S SUPP=$P(LINE,"|",15) 180 . I SUPP="O"!(SUPP="Y")!(SUPP="E") S C0CSUPP=C0CSUPP+1 QUIT 181 . ; 182 . IF $$STATUS^%ZISH QUIT 183 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 184 . ; swap RXCUI1 location with SAB b/c SAB is required so can be .01 field 185 . N RXCUI1 S RXCUI1=$P(LINE,"|",1) 186 . N SAB S SAB=$P(LINE,"|",11) 187 . S $P(LINE,"|",1)=SAB 188 . S $P(LINE,"|",11)=RXCUI1 189 . S ^C0CRXN(176.005,I,0)=$TR(LINE,"^|","|^") 190 EX5 D CLOSE^%ZISH("FILE") 191 N DIK S DIK="^C0CRXN(176.005," D IXALL^DIK 192 W "Suppressed: ",C0CSUPP,! 193 QUIT 194 DOC(PATH) ; Open the read RxNorm Abbreviation Documentation file: RXNDOC.RRF 195 I PATH="" QUIT 196 N FILENAME S FILENAME="RXNDOC.RRF" 197 D DELFILED(176.006) ; delete data 198 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 199 N POP 200 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 201 IF POP W "Error reading file..., Please check...",! G EX6 202 N I F I=1:1 Q:$$STATUS^%ZISH D 203 . U IO 204 . N LINE R LINE:0 205 . IF $$STATUS^%ZISH QUIT 206 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 207 . S ^C0CRXN(176.006,I,0)=$TR(LINE,"^|","|^") 208 EX6 D CLOSE^%ZISH("FILE") 209 N DIK S DIK="^C0CRXN(176.006," D IXALL^DIK 210 QUIT
Note:
See TracChangeset
for help on using the changeset viewer.
