Ignore:
Timestamp:
Jan 4, 2012, 12:05:03 AM (12 years ago)
Author:
George Lilly
Message:

reset to certification routines with tabs

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/branches/ohum/p/C0CRXNRD.m

    r1330 r1332  
    1 C0CRXNRD        ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
    2         ;;0.1;C0C;nopatch;noreleasedate;Build 1
    3         W "No entry from top" Q
    4 IMPORT(PATH)   
    5         I PATH="" QUIT
    6         D READSRC(PATH),READCON(PATH),READNDC(PATH)
    7         QUIT
    8         ;
    9 DELFILED(FN)    ; Delete file data; PEP procedure; only for RxNorm files
    10         ; FN is Filenumber passed by Value
    11         QUIT:$E(FN,1,3)'=176  ; Quit if not RxNorm files
    12         D CLEAN^DILF ; Clean FM variables
    13         N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root
    14         N ZERO S ZERO=@ROOT@(0) ; Save zero node
    15         S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited
    16         K @ROOT ; Kill the file -- so sad!
    17         S @ROOT@(0)=ZERO ; It riseth again!
    18         QUIT
    19 GETLINES(PATH,FILENAME) ; Get number of lines in a file
    20         D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
    21         U IO
    22         N I
    23         F I=1:1 R LINE Q:$$STATUS^%ZISH
    24         D CLOSE^%ZISH("FILE")
    25         Q I-1
    26 READCON(PATH,INCRES)    ; Open and read concepts file: RXNCONSO.RRF; EP
    27         ; PATH ByVal, path of RxNorm files
    28         ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no
    29         I PATH="" QUIT
    30         S INCRES=+$G(INCRES) ; if not passed, becomes zero.
    31         N FILENAME S FILENAME="RXNCONSO.RRF"
    32         D DELFILED(176.001) ; delete data
    33         N LINES S LINES=$$GETLINES(PATH,FILENAME)
    34         D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
    35         IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
    36         N C0CCOUNT
    37         F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
    38         . U IO
    39         . N LINE R LINE
    40         . IF $$STATUS^%ZISH QUIT
    41         . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
    42         . N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below
    43         . S RXCUI=$P(LINE,"|",1)        ; .01
    44         . S RXAUI=$P(LINE,"|",8)        ; 1
    45         . S SAB=$P(LINE,"|",12) ; 2
    46         . ; If the source is a restricted source, decide what to do based on what's asked.
    47         . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
    48         . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
    49         . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
    50         . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
    51         . I 'INCRES,RESTRIC QUIT
    52         . S TTY=$P(LINE,"|",13) ; 3
    53         . S CODE=$P(LINE,"|",14)        ; 4
    54         . S STR=$P(LINE,"|",15) ; 5
    55         . ; Remove embedded "^"
    56         . S STR=$TR(STR,"^")
    57         . ; Convert STR into an array of 80 characters on each line
    58         . N STRLINE S STRLINE=$L(STR)\80+1
    59         . ; In each line, chop 80 characters off, reset STR to be the rest
    60         . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
    61         . ; Now, construct the FDA array
    62         . N RXNFDA
    63         . S RXNFDA(176.001,"+1,",.01)=RXCUI
    64         . S RXNFDA(176.001,"+1,",1)=RXAUI
    65         . S RXNFDA(176.001,"+1,",2)=SAB
    66         . S RXNFDA(176.001,"+1,",3)=TTY
    67         . S RXNFDA(176.001,"+1,",4)=CODE
    68         . N RXNIEN S RXNIEN(1)=C0CCOUNT
    69         . D UPDATE^DIE("","RXNFDA","RXNIEN")
    70         . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
    71         . ; Now, file WP field STR
    72         . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR))
    73 EX      D CLOSE^%ZISH("FILE")
    74         QUIT
    75 READNDC(PATH)   ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
    76         I PATH="" QUIT
    77         N FILENAME S FILENAME="RXNSAT.RRF"
    78         D DELFILED(176.002) ; delete data
    79         N LINES S LINES=$$GETLINES(PATH,FILENAME)
    80         D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
    81         IF POP W "Error reading file..., Please check...",! G EX2
    82         F C0CCOUNT=1:1 Q:$$STATUS^%ZISH  D
    83         . U IO
    84         . N LINE R LINE
    85         . IF $$STATUS^%ZISH QUIT
    86         . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
    87         . IF LINE'["NDC|RXNORM"  QUIT
    88         . ; Otherwise, we are good to go
    89         . N RXCUI,NDC ; Fileman fields below
    90         . S RXCUI=$P(LINE,"|",1)        ; .01
    91         . S NDC=$P(LINE,"|",11) ; 2
    92         . ; Using classic call to update.
    93         . N DIC,X,DA,DR
    94         . K DO
    95         . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC
    96         . D FILE^DICN
    97         . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2
    98 EX2     D CLOSE^%ZISH("FILE")
    99         QUIT
    100 READSRC(PATH)   ; Open the read RxNorm Sources file: RXNSAB.RRF
    101         I PATH="" QUIT
    102         N FILENAME S FILENAME="RXNSAB.RRF"
    103         D DELFILED(176.003) ; delete data
    104         D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
    105         IF POP W "Error reading file..., Please check...",! G EX3
    106         F I=1:1 Q:$$STATUS^%ZISH  D
    107         . U IO
    108         . N LINE R LINE
    109         . IF $$STATUS^%ZISH QUIT
    110         . U $P W I,! U IO  ; Write I to the screen, then go back to reading the file
    111         . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
    112         . S VCUI=$P(LINE,"|",1)        ; .01
    113         . S RCUI=$P(LINE,"|",2)        ; 2
    114         . S VSAB=$P(LINE,"|",3)        ; 3
    115         . S RSAB=$P(LINE,"|",4)        ; 4
    116         . S SON=$P(LINE,"|",5)         ; 5
    117         . S SF=$P(LINE,"|",6)          ; 6
    118         . S SVER=$P(LINE,"|",7)        ; 7
    119         . S SRL=$P(LINE,"|",14)         ; 14
    120         . S SCIT=$P(LINE,"|",25)       ; 25
    121         . ; Remove embedded "^"
    122         . S SCIT=$TR(SCIT,"^")
    123         . ; Convert SCIT into an array of 80 characters on each line
    124         . ; In each line, chop 80 characters off, reset SCIT to be the rest
    125         . N SCITLINE S SCITLINE=$L(SCIT)\80+1
    126         . F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT))
    127         . ; Now, construct the FDA array
    128         . N RXNFDA
    129         . S RXNFDA(176.003,"+"_I_",",.01)=VCUI
    130         . S RXNFDA(176.003,"+"_I_",",2)=RCUI
    131         . S RXNFDA(176.003,"+"_I_",",3)=VSAB
    132         . S RXNFDA(176.003,"+"_I_",",4)=RSAB
    133         . S RXNFDA(176.003,"+"_I_",",5)=SON
    134         . S RXNFDA(176.003,"+"_I_",",6)=SF
    135         . S RXNFDA(176.003,"+"_I_",",7)=SVER
    136         . S RXNFDA(176.003,"+"_I_",",14)=SRL
    137         . D UPDATE^DIE("","RXNFDA")
    138         . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX
    139         . ; Now, file WP field SCIT
    140         . D WP^DIE(176.003,I_",",25,,$NA(SCIT))
    141 EX3     D CLOSE^%ZISH("FILE")
    142         Q
    143        
     1C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
     2 ;;0.1;C0C;nopatch;noreleasedate
     3 W "No entry from top" Q
     4IMPORT(PATH)
     5 I PATH="" QUIT
     6 D READSRC(PATH),READCON(PATH),READNDC(PATH)
     7 QUIT
     8 ;
     9DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files
     10 ; FN is Filenumber passed by Value
     11 QUIT:$E(FN,1,3)'=176  ; Quit if not RxNorm files
     12 D CLEAN^DILF ; Clean FM variables
     13 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root
     14 N ZERO S ZERO=@ROOT@(0) ; Save zero node
     15 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited
     16 K @ROOT ; Kill the file -- so sad!
     17 S @ROOT@(0)=ZERO ; It riseth again!
     18 QUIT
     19GETLINES(PATH,FILENAME) ; Get number of lines in a file
     20 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
     21 U IO
     22 N I
     23 F I=1:1 R LINE Q:$$STATUS^%ZISH
     24 D CLOSE^%ZISH("FILE")
     25 Q I-1
     26READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
     27 ; PATH ByVal, path of RxNorm files
     28 ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no
     29 I PATH="" QUIT
     30 S INCRES=+$G(INCRES) ; if not passed, becomes zero.
     31 N FILENAME S FILENAME="RXNCONSO.RRF"
     32 D DELFILED(176.001) ; delete data
     33 N LINES S LINES=$$GETLINES(PATH,FILENAME)
     34 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
     35 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
     36 N C0CCOUNT
     37 F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
     38 . U IO
     39 . N LINE R LINE
     40 . IF $$STATUS^%ZISH QUIT
     41 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
     42 . N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below
     43 . S RXCUI=$P(LINE,"|",1)       ; .01
     44 . S RXAUI=$P(LINE,"|",8)       ; 1
     45 . S SAB=$P(LINE,"|",12)        ; 2
     46 . ; If the source is a restricted source, decide what to do based on what's asked.
     47 . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
     48 . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
     49 . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
     50 . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
     51 . I 'INCRES,RESTRIC QUIT
     52 . S TTY=$P(LINE,"|",13)        ; 3
     53 . S CODE=$P(LINE,"|",14)       ; 4
     54 . S STR=$P(LINE,"|",15)        ; 5
     55 . ; Remove embedded "^"
     56 . S STR=$TR(STR,"^")
     57 . ; Convert STR into an array of 80 characters on each line
     58 . N STRLINE S STRLINE=$L(STR)\80+1
     59 . ; In each line, chop 80 characters off, reset STR to be the rest
     60 . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
     61 . ; Now, construct the FDA array
     62 . N RXNFDA
     63 . S RXNFDA(176.001,"+1,",.01)=RXCUI
     64 . S RXNFDA(176.001,"+1,",1)=RXAUI
     65 . S RXNFDA(176.001,"+1,",2)=SAB
     66 . S RXNFDA(176.001,"+1,",3)=TTY
     67 . S RXNFDA(176.001,"+1,",4)=CODE
     68 . N RXNIEN S RXNIEN(1)=C0CCOUNT
     69 . D UPDATE^DIE("","RXNFDA","RXNIEN")
     70 . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
     71 . ; Now, file WP field STR
     72 . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR))
     73EX D CLOSE^%ZISH("FILE")
     74 QUIT
     75READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
     76 I PATH="" QUIT
     77 N FILENAME S FILENAME="RXNSAT.RRF"
     78 D DELFILED(176.002) ; delete data
     79 N LINES S LINES=$$GETLINES(PATH,FILENAME)
     80 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
     81 IF POP W "Error reading file..., Please check...",! G EX2
     82 F C0CCOUNT=1:1 Q:$$STATUS^%ZISH  D
     83 . U IO
     84 . N LINE R LINE
     85 . IF $$STATUS^%ZISH QUIT
     86 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
     87 . IF LINE'["NDC|RXNORM"  QUIT
     88 . ; Otherwise, we are good to go
     89 . N RXCUI,NDC ; Fileman fields below
     90 . S RXCUI=$P(LINE,"|",1)       ; .01
     91 . S NDC=$P(LINE,"|",11)        ; 2
     92 . ; Using classic call to update.
     93 . N DIC,X,DA,DR
     94 . K DO
     95 . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC
     96 . D FILE^DICN
     97 . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2
     98EX2 D CLOSE^%ZISH("FILE")
     99 QUIT
     100READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF
     101 I PATH="" QUIT
     102 N FILENAME S FILENAME="RXNSAB.RRF"
     103 D DELFILED(176.003) ; delete data
     104 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
     105 IF POP W "Error reading file..., Please check...",! G EX3
     106 F I=1:1 Q:$$STATUS^%ZISH  D
     107 . U IO
     108 . N LINE R LINE
     109 . IF $$STATUS^%ZISH QUIT
     110 . U $P W I,! U IO  ; Write I to the screen, then go back to reading the file
     111 . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
     112 . S VCUI=$P(LINE,"|",1)        ; .01
     113 . S RCUI=$P(LINE,"|",2)        ; 2
     114 . S VSAB=$P(LINE,"|",3)        ; 3
     115 . S RSAB=$P(LINE,"|",4)        ; 4
     116 . S SON=$P(LINE,"|",5)         ; 5
     117 . S SF=$P(LINE,"|",6)          ; 6
     118 . S SVER=$P(LINE,"|",7)        ; 7
     119 . S SRL=$P(LINE,"|",14)                ; 14
     120 . S SCIT=$P(LINE,"|",25)       ; 25
     121 . ; Remove embedded "^"
     122 . S SCIT=$TR(SCIT,"^")
     123 . ; Convert SCIT into an array of 80 characters on each line
     124 . ; In each line, chop 80 characters off, reset SCIT to be the rest
     125 . N SCITLINE S SCITLINE=$L(SCIT)\80+1
     126 . F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT))
     127 . ; Now, construct the FDA array
     128 . N RXNFDA
     129 . S RXNFDA(176.003,"+"_I_",",.01)=VCUI
     130 . S RXNFDA(176.003,"+"_I_",",2)=RCUI
     131 . S RXNFDA(176.003,"+"_I_",",3)=VSAB
     132 . S RXNFDA(176.003,"+"_I_",",4)=RSAB
     133 . S RXNFDA(176.003,"+"_I_",",5)=SON
     134 . S RXNFDA(176.003,"+"_I_",",6)=SF
     135 . S RXNFDA(176.003,"+"_I_",",7)=SVER
     136 . S RXNFDA(176.003,"+"_I_",",14)=SRL
     137 . D UPDATE^DIE("","RXNFDA")
     138 . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX
     139 . ; Now, file WP field SCIT
     140 . D WP^DIE(176.003,I_",",25,,$NA(SCIT))
     141EX3 D CLOSE^%ZISH("FILE")
     142 Q
     143
Note: See TracChangeset for help on using the changeset viewer.