C0CRXNRD.m

C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08

 ;;0.1;C0C;nopatch;noreleasedate;Build 6

 W "No entry from top" Q

IMPORT(PATH) 

 I PATH="" QUIT

 D READSRC(PATH),READCON(PATH),READNDC(PATH)

 QUIT

 ;

DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files

 ; FN is Filenumber passed by Value

 QUIT:$E(FN,1,3)'=176  ; Quit if not RxNorm files

 D CLEAN^DILF ; Clean FM variables

 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root

 N ZERO S ZERO=@ROOT@(0) ; Save zero node

 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited

 K @ROOT ; Kill the file -- so sad!

 S @ROOT@(0)=ZERO ; It riseth again!

 QUIT

GETLINES(PATH,FILENAME) ; Get number of lines in a file

 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 U IO

 N I

 F I=1:1 R LINE Q:$$STATUS^%ZISH

 D CLOSE^%ZISH("FILE")

 Q I-1

READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP

 ; PATH ByVal, path of RxNorm files

 ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no

 I PATH="" QUIT

 S INCRES=+$G(INCRES) ; if not passed, becomes zero.

 N FILENAME S FILENAME="RXNCONSO.RRF"

 D DELFILED(176.001) ; delete data

 N LINES S LINES=$$GETLINES(PATH,FILENAME)

 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX

 N C0CCOUNT

 F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH

 . U IO

 . N LINE R LINE

 . IF $$STATUS^%ZISH QUIT

 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000

 . N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below

 . S RXCUI=$P(LINE,"|",1)	; .01

 . S RXAUI=$P(LINE,"|",8)	; 1

 . S SAB=$P(LINE,"|",12)	; 2

 . ; If the source is a restricted source, decide what to do based on what's asked.

 . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file

 . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4

 . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.

 . ; If user didn't ask to include restricted sources, and the source is restricted, then quit

 . I 'INCRES,RESTRIC QUIT

 . S TTY=$P(LINE,"|",13)	; 3

 . S CODE=$P(LINE,"|",14)	; 4

 . S STR=$P(LINE,"|",15)	; 5

 . ; Remove embedded "^"

 . S STR=$TR(STR,"^")

 . ; Convert STR into an array of 80 characters on each line

 . N STRLINE S STRLINE=$L(STR)\80+1

 . ; In each line, chop 80 characters off, reset STR to be the rest

 . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))

 . ; Now, construct the FDA array

 . N RXNFDA

 . S RXNFDA(176.001,"+1,",.01)=RXCUI

 . S RXNFDA(176.001,"+1,",1)=RXAUI

 . S RXNFDA(176.001,"+1,",2)=SAB

 . S RXNFDA(176.001,"+1,",3)=TTY

 . S RXNFDA(176.001,"+1,",4)=CODE

 . N RXNIEN S RXNIEN(1)=C0CCOUNT

 . D UPDATE^DIE("","RXNFDA","RXNIEN")

 . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX

 . ; Now, file WP field STR

 . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR))

EX D CLOSE^%ZISH("FILE")

 QUIT

READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF

 I PATH="" QUIT

 N FILENAME S FILENAME="RXNSAT.RRF"

 D DELFILED(176.002) ; delete data

 N LINES S LINES=$$GETLINES(PATH,FILENAME)

 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 IF POP W "Error reading file..., Please check...",! G EX2

 F C0CCOUNT=1:1 Q:$$STATUS^%ZISH  D

 . U IO

 . N LINE R LINE

 . IF $$STATUS^%ZISH QUIT

 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000

 . IF LINE'["NDC|RXNORM"  QUIT

 . ; Otherwise, we are good to go

 . N RXCUI,NDC ; Fileman fields below

 . S RXCUI=$P(LINE,"|",1)	; .01

 . S NDC=$P(LINE,"|",11)	; 2

 . ; Using classic call to update.

 . N DIC,X,DA,DR

 . K DO

 . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC

 . D FILE^DICN

 . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2

EX2 D CLOSE^%ZISH("FILE")

 QUIT

READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF

 I PATH="" QUIT

 N FILENAME S FILENAME="RXNSAB.RRF"

 D DELFILED(176.003) ; delete data

 D OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 IF POP W "Error reading file..., Please check...",! G EX3

 F I=1:1 Q:$$STATUS^%ZISH  D

 . U IO

 . N LINE R LINE

 . IF $$STATUS^%ZISH QUIT

 . U $P W I,! U IO  ; Write I to the screen, then go back to reading the file

 . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below

 . S VCUI=$P(LINE,"|",1)        ; .01

 . S RCUI=$P(LINE,"|",2)        ; 2

 . S VSAB=$P(LINE,"|",3)        ; 3

 . S RSAB=$P(LINE,"|",4)        ; 4

 . S SON=$P(LINE,"|",5)         ; 5

 . S SF=$P(LINE,"|",6)          ; 6

 . S SVER=$P(LINE,"|",7)        ; 7

 . S SRL=$P(LINE,"|",14)		; 14

 . S SCIT=$P(LINE,"|",25)       ; 25

 . ; Remove embedded "^"

 . S SCIT=$TR(SCIT,"^")

 . ; Convert SCIT into an array of 80 characters on each line

 . ; In each line, chop 80 characters off, reset SCIT to be the rest

 . N SCITLINE S SCITLINE=$L(SCIT)\80+1

 . F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT))

 . ; Now, construct the FDA array

 . N RXNFDA

 . S RXNFDA(176.003,"+"_I_",",.01)=VCUI

 . S RXNFDA(176.003,"+"_I_",",2)=RCUI

 . S RXNFDA(176.003,"+"_I_",",3)=VSAB

 . S RXNFDA(176.003,"+"_I_",",4)=RSAB

 . S RXNFDA(176.003,"+"_I_",",5)=SON

 . S RXNFDA(176.003,"+"_I_",",6)=SF

 . S RXNFDA(176.003,"+"_I_",",7)=SVER

 . S RXNFDA(176.003,"+"_I_",",14)=SRL

 . D UPDATE^DIE("","RXNFDA")

 . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX

 . ; Now, file WP field SCIT

 . D WP^DIE(176.003,I_",",25,,$NA(SCIT))

EX3 D CLOSE^%ZISH("FILE")

 Q

C0CRXNRD  ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08

 +1       ;;0.1;C0C;nopatch;noreleasedate;Build 6

 +2        WRITE "No entry from top"

           QUIT 

IMPORT(PATH)  +1  IF PATH=""

               QUIT 

 +2        DO READSRC(PATH)

           DO READCON(PATH)

           DO READNDC(PATH)

 +3        QUIT 

 +4       ;

DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files

 +1       ; FN is Filenumber passed by Value

 +2       ; Quit if not RxNorm files

           IF $EXTRACT(FN,1,3)'=176

               QUIT 

 +3       ; Clean FM variables

           DO CLEAN^DILF

 +4       ; global root

           NEW ROOT

           SET ROOT=$$ROOT^DILFD(FN,"",1)

 +5       ; Save zero node

           NEW ZERO

           SET ZERO=@ROOT@(0)

 +6       ; Remove entry # and last edited

           SET $PIECE(ZERO,U,3,9999)=""

 +7       ; Kill the file -- so sad!

           KILL @ROOT

 +8       ; It riseth again!

           SET @ROOT@(0)=ZERO

 +9        QUIT 

GETLINES(PATH,FILENAME) ; Get number of lines in a file

 +1        DO OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 +2        USE IO

 +3        NEW I

 +4        FOR I=1:1

               READ LINE

               IF $$STATUS^%ZISH

                   QUIT 

 +5        DO CLOSE^%ZISH("FILE")

 +6        QUIT I-1

READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP

 +1       ; PATH ByVal, path of RxNorm files

 +2       ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no

 +3        IF PATH=""

               QUIT 

 +4       ; if not passed, becomes zero.

           SET INCRES=+$GET(INCRES)

 +5        NEW FILENAME

           SET FILENAME="RXNCONSO.RRF"

 +6       ; delete data

           DO DELFILED(176.001)

 +7        NEW LINES

           SET LINES=$$GETLINES(PATH,FILENAME)

 +8        DO OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 +9        IF POP

               DO EN^DDIOL("Error reading file..., Please check...")

               GOTO EX

 +10       NEW C0CCOUNT

 +11       FOR C0CCOUNT=1:1

               Begin DoDot:1

 +12               USE IO

 +13               NEW LINE

                   READ LINE

 +14               IF $$STATUS^%ZISH

                       QUIT 

 +15      ; update every 1000

                   IF '(C0CCOUNT#1000)

                       USE $PRINCIPAL

                       WRITE C0CCOUNT," of ",LINES," read ",!

                       USE IO

 +16      ; Fileman fields numbers below

                   NEW RXCUI,RXAUI,SAB,TTY,CODE,STR

 +17      ; .01

                   SET RXCUI=$PIECE(LINE,"|",1)

 +18      ; 1

                   SET RXAUI=$PIECE(LINE,"|",8)

 +19      ; 2

                   SET SAB=$PIECE(LINE,"|",12)

 +20      ; If the source is a restricted source, decide what to do based on what's asked.

 +21      ; SrcIEN in RXNORM SOURCES file

                   NEW SRCIEN

                   SET SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B")

 +22      ; 14 is restriction field; values 0-4

                   NEW RESTRIC

                   SET RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I")

 +23      ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.

 +24      ; If user didn't ask to include restricted sources, and the source is restricted, then quit

 +25               IF 'INCRES

                       IF RESTRIC

                           QUIT 

 +26      ; 3

                   SET TTY=$PIECE(LINE,"|",13)

 +27      ; 4

                   SET CODE=$PIECE(LINE,"|",14)

 +28      ; 5

                   SET STR=$PIECE(LINE,"|",15)

 +29      ; Remove embedded "^"

 +30               SET STR=$TRANSLATE(STR,"^")

 +31      ; Convert STR into an array of 80 characters on each line

 +32               NEW STRLINE

                   SET STRLINE=$LENGTH(STR)\80+1

 +33      ; In each line, chop 80 characters off, reset STR to be the rest

 +34               NEW J

                   FOR J=1:1:STRLINE

                       SET STR(J)=$EXTRACT(STR,1,80)

                       SET STR=$EXTRACT(STR,81,$LENGTH(STR))

 +35      ; Now, construct the FDA array

 +36               NEW RXNFDA

 +37               SET RXNFDA(176.001,"+1,",.01)=RXCUI

 +38               SET RXNFDA(176.001,"+1,",1)=RXAUI

 +39               SET RXNFDA(176.001,"+1,",2)=SAB

 +40               SET RXNFDA(176.001,"+1,",3)=TTY

 +41               SET RXNFDA(176.001,"+1,",4)=CODE

 +42               NEW RXNIEN

                   SET RXNIEN(1)=C0CCOUNT

 +43               DO UPDATE^DIE("","RXNFDA","RXNIEN")

 +44               IF $DATA(^TMP("DIERR",$JOB))

                       DO EN^DDIOL("ERROR")

                       GOTO EX

 +45      ; Now, file WP field STR

 +46               DO WP^DIE(176.001,C0CCOUNT_",",5,,$NAME(STR))

               End DoDot:1

               IF $$STATUS^%ZISH

                   QUIT 

EX         DO CLOSE^%ZISH("FILE")

 +1        QUIT 

READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF

 +1        IF PATH=""

               QUIT 

 +2        NEW FILENAME

           SET FILENAME="RXNSAT.RRF"

 +3       ; delete data

           DO DELFILED(176.002)

 +4        NEW LINES

           SET LINES=$$GETLINES(PATH,FILENAME)

 +5        DO OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 +6        IF POP

               WRITE "Error reading file..., Please check...",!

               GOTO EX2

 +7        FOR C0CCOUNT=1:1

               IF $$STATUS^%ZISH

                   QUIT 

               Begin DoDot:1

 +8                USE IO

 +9                NEW LINE

                   READ LINE

 +10               IF $$STATUS^%ZISH

                       QUIT 

 +11      ; update every 1000

                   IF '(C0CCOUNT#1000)

                       USE $PRINCIPAL

                       WRITE C0CCOUNT," of ",LINES," read ",!

                       USE IO

 +12               IF LINE'["NDC|RXNORM"

                       QUIT 

 +13      ; Otherwise, we are good to go

 +14      ; Fileman fields below

                   NEW RXCUI,NDC

 +15      ; .01

                   SET RXCUI=$PIECE(LINE,"|",1)

 +16      ; 2

                   SET NDC=$PIECE(LINE,"|",11)

 +17      ; Using classic call to update.

 +18               NEW DIC,X,DA,DR

 +19               KILL DO

 +20               SET DIC="^C0CRXN(176.002,"

                   SET DIC(0)="F"

                   SET X=RXCUI

                   SET DIC("DR")="2////"_NDC

 +21               DO FILE^DICN

 +22               IF Y<1

                       USE $PRINCIPAL

                       WRITE !,"THERE IS TROUBLE IN RIVER CITY",!

                       GOTO EX2

               End DoDot:1

EX2        DO CLOSE^%ZISH("FILE")

 +1        QUIT 

READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF

 +1        IF PATH=""

               QUIT 

 +2        NEW FILENAME

           SET FILENAME="RXNSAB.RRF"

 +3       ; delete data

           DO DELFILED(176.003)

 +4        DO OPEN^%ZISH("FILE",PATH,FILENAME,"R")

 +5        IF POP

               WRITE "Error reading file..., Please check...",!

               GOTO EX3

 +6        FOR I=1:1

               IF $$STATUS^%ZISH

                   QUIT 

               Begin DoDot:1

 +7                USE IO

 +8                NEW LINE

                   READ LINE

 +9                IF $$STATUS^%ZISH

                       QUIT 

 +10      ; Write I to the screen, then go back to reading the file

                   USE $PRINCIPAL

                   WRITE I,!

                   USE IO

 +11      ; Fileman fields numbers below

                   NEW VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT

 +12      ; .01

                   SET VCUI=$PIECE(LINE,"|",1)

 +13      ; 2

                   SET RCUI=$PIECE(LINE,"|",2)

 +14      ; 3

                   SET VSAB=$PIECE(LINE,"|",3)

 +15      ; 4

                   SET RSAB=$PIECE(LINE,"|",4)

 +16      ; 5

                   SET SON=$PIECE(LINE,"|",5)

 +17      ; 6

                   SET SF=$PIECE(LINE,"|",6)

 +18      ; 7

                   SET SVER=$PIECE(LINE,"|",7)

 +19      ; 14

                   SET SRL=$PIECE(LINE,"|",14)	

 +20      ; 25

                   SET SCIT=$PIECE(LINE,"|",25)

 +21      ; Remove embedded "^"

 +22               SET SCIT=$TRANSLATE(SCIT,"^")

 +23      ; Convert SCIT into an array of 80 characters on each line

 +24      ; In each line, chop 80 characters off, reset SCIT to be the rest

 +25               NEW SCITLINE

                   SET SCITLINE=$LENGTH(SCIT)\80+1

 +26               FOR J=1:1:SCITLINE

                       SET SCIT(J)=$EXTRACT(SCIT,1,80)

                       SET SCIT=$EXTRACT(SCIT,81,$LENGTH(SCIT))

 +27      ; Now, construct the FDA array

 +28               NEW RXNFDA

 +29               SET RXNFDA(176.003,"+"_I_",",.01)=VCUI

 +30               SET RXNFDA(176.003,"+"_I_",",2)=RCUI

 +31               SET RXNFDA(176.003,"+"_I_",",3)=VSAB

 +32               SET RXNFDA(176.003,"+"_I_",",4)=RSAB

 +33               SET RXNFDA(176.003,"+"_I_",",5)=SON

 +34               SET RXNFDA(176.003,"+"_I_",",6)=SF

 +35               SET RXNFDA(176.003,"+"_I_",",7)=SVER

 +36               SET RXNFDA(176.003,"+"_I_",",14)=SRL

 +37               DO UPDATE^DIE("","RXNFDA")

 +38               IF $DATA(^TMP("DIERR",$JOB))

                       USE $PRINCIPAL

                       WRITE "ERR"

                       GOTO EX

 +39      ; Now, file WP field SCIT

 +40               DO WP^DIE(176.003,I_",",25,,$NAME(SCIT))

               End DoDot:1

EX3        DO CLOSE^%ZISH("FILE")

 +1        QUIT 

 +2 

*****   ERRORS & WARNINGS IN C0CRXNRD   *****

   IMPORT       W - Null line (no commands or comment).

   READCON+17   W - Line contains a CONTROL (non-graphic) character.

   READCON+17   F - Invalid or wrong number of arguments to a function.

   READCON+17   W - Invalid local variable name.

   READCON+17   F - UNDEFINED COMMAND (rest of line not checked).

   READCON+18   W - Line contains a CONTROL (non-graphic) character.

   READCON+18   F - Invalid or wrong number of arguments to a function.

   READCON+18   W - Invalid local variable name.

   READCON+18   F - UNDEFINED COMMAND (rest of line not checked).

   READCON+19   W - Line contains a CONTROL (non-graphic) character.

   READCON+19   F - Invalid or wrong number of arguments to a function.

   READCON+19   W - Invalid local variable name.

   READCON+19   F - UNDEFINED COMMAND (rest of line not checked).

   READCON+26   W - Line contains a CONTROL (non-graphic) character.

   READCON+26   F - Invalid or wrong number of arguments to a function.

   READCON+26   W - Invalid local variable name.

   READCON+26   F - UNDEFINED COMMAND (rest of line not checked).

   READCON+27   W - Line contains a CONTROL (non-graphic) character.

   READCON+27   F - Invalid or wrong number of arguments to a function.

   READCON+27   W - Invalid local variable name.

   READCON+27   F - UNDEFINED COMMAND (rest of line not checked).

   READCON+28   W - Line contains a CONTROL (non-graphic) character.

   READCON+28   F - Invalid or wrong number of arguments to a function.

   READCON+28   W - Invalid local variable name.

   READCON+28   F - UNDEFINED COMMAND (rest of line not checked).

   READNDC+15   W - Line contains a CONTROL (non-graphic) character.

   READNDC+15   F - Invalid or wrong number of arguments to a function.

   READNDC+15   W - Invalid local variable name.

   READNDC+15   F - UNDEFINED COMMAND (rest of line not checked).

   READNDC+16   W - Line contains a CONTROL (non-graphic) character.

   READNDC+16   F - Invalid or wrong number of arguments to a function.

   READNDC+16   W - Invalid local variable name.

   READNDC+16   F - UNDEFINED COMMAND (rest of line not checked).

   READSRC+19   W - Line contains a CONTROL (non-graphic) character.

   READSRC+19   F - Invalid or wrong number of arguments to a function.

   READSRC+19   W - Invalid local variable name.

   READSRC+19   F - UNDEFINED COMMAND (rest of line not checked).

   EX3+2        W - Null line (no commands or comment).