source: ccr/trunk/p/C0CRXNRD.m@ 503

Last change on this file since 503 was 369, checked in by Sam Habiel, 16 years ago

Added "DCO_Sam_Habiel.txt"

File size: 2.3 KB
Line 
1C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
2 ;;0.1;CCDCCR;nopatch;noreleasedate
3 W "No entry from top" Q
4 ;
5READCON(PATH) ; Open and read concepts file: RXNCONSO.RRF
6 I PATH="" QUIT
7 N FILENAME S FILENAME="RXNCONSO.RRF"
8 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
9 IF POP W "Error reading file..., Please check...",! BREAK
10 F I=1:1 Q:$$STATUS^%ZISH D
11 . U IO
12 . N LINE R LINE
13 . IF $$STATUS^%ZISH QUIT
14 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file
15 . N RXCUI,RXAUI,SAB,TTY,CODE,STR ; Fileman fields numbers below
16 . S RXCUI=$P(LINE,"|",1) ; .01
17 . S RXAUI=$P(LINE,"|",8) ; 1
18 . S SAB=$P(LINE,"|",12) ; 2
19 . S TTY=$P(LINE,"|",13) ; 3
20 . S CODE=$P(LINE,"|",14) ; 4
21 . S STR=$P(LINE,"|",15) ; 5
22 . ; Remove embedded "^"
23 . S STR=$TR(STR,"^")
24 . ; Convert STR into an array of 80 characters on each line
25 . N STRLINE S STRLINE=$L(STR)\80+1
26 . ; In each line, chop 80 characters off, reset STR to be the rest
27 . F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
28 . ; Now, construct the FDA array
29 . N RXNFDA
30 . S RXNFDA(176.001,"+"_I_",",.01)=RXCUI
31 . S RXNFDA(176.001,"+"_I_",",1)=RXAUI
32 . S RXNFDA(176.001,"+"_I_",",2)=SAB
33 . S RXNFDA(176.001,"+"_I_",",3)=TTY
34 . S RXNFDA(176.001,"+"_I_",",4)=CODE
35 . D UPDATE^DIE("","RXNFDA")
36 . I $D(^TMP("DIERR",$J)) U $P BREAK
37 . ; Now, file WP field STR
38 . D WP^DIE(176.001,I_",",5,,$NA(STR))
39 D CLOSE^%ZISH("FILE")
40 Q
41 ;
42READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
43 I PATH="" QUIT
44 N FILENAME S FILENAME="RXNSAT.RRF"
45 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
46 IF POP W "Error reading file..., Please check...",! BREAK
47 F I=1:1 Q:$$STATUS^%ZISH D
48 . U IO
49 . N LINE R LINE
50 . IF $$STATUS^%ZISH QUIT
51 . U $P W I U IO
52 . IF LINE'["NDC|RXNORM" U $P W ?20,"No NDC Here :-)",! U IO QUIT
53 . ; Otherwise, we are good to go
54 . U $P W ?20,"Found RXNORM/NDC Set",! U IO
55 . N RXCUI,NDC ; Fileman fields below
56 . S RXCUI=$P(LINE,"|",1) ; .01
57 . S NDC=$P(LINE,"|",11) ; 2
58 . ; Using classic call to update.
59 . N DIC,X,DA,DR
60 . K DO
61 . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI
62 . D FILE^DICN
63 . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! BREAK
64 . S DIE=DIC,DA=$P(Y,"^")
65 . S DR="2////^S X=NDC"
66 . D ^DIE
67 D CLOSE^%ZISH("FILE")
68 U $P ; reset back to principle device
69 QUIT
Note: See TracBrowser for help on using the repository browser.