LRUSE.m

LRUSE ; IHS/DIR/FJE - ENTER/EDIT SNOMED FIELDS 6/2/86 9:12 AM ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

OPTS R !!,"Select SNOMED FIELD to edit: ",X:DTIME Q:X=""!(X["^")

 F A=1:1 S Y=$P($T(OPT+A),";",3) Q:Y=""  G:$E(X,1)=$P(Y,"^",2) DO

 W !!,"Select from:" G LST

DO W " ",$E($P(Y,"^"),7,$L($P(Y,"^"))),! S DR=$P($T(OPT+A),"^",4),F=$P(Y,"^",3)

ASK W ! S (DIC,DIE,DLAYGO)=F,DIC(0)="AEQLM" D ^DIC K DIC,DLAYGO G:Y<1 OPTS S DA=+Y D ^DIE G ASK

LST W ! F A=1:1 W !,?15,$P($P($T(OPT+A),";",3),"^") Q:$T(OPT+A)=""

 G OPTS

OPT ;OPTION LIST

 ;;T ==> Topography Field^T^61^.01;2;3;4;6

 ;;M ==> Morphology Field^M^61.1^.01;2;3;6

 ;;E ==> Etiology Field^E^61.2^.01;2;7;6

 ;;D ==> Disease Field^D^61.4^.01;2;3;6

 ;;F ==> Function Field^F^61.3^.01;2;3;6

 ;;P ==> Procedure Field^P^61.5^.01;2;3;6

 ;;O ==> Occupation Field^O^61.6^.01;2;3;6

LRUSE     ; IHS/DIR/FJE - ENTER/EDIT SNOMED FIELDS 6/2/86 9:12 AM ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

OPTS       READ !!,"Select SNOMED FIELD to edit: ",X:DTIME

           IF X=""!(X["^")

               QUIT 

 +1        FOR A=1:1

               SET Y=$PIECE($TEXT(OPT+A),";",3)

               IF Y=""

                   QUIT 

               IF $EXTRACT(X,1)=$PIECE(Y,"^",2)

                   GOTO DO

 +2        WRITE !!,"Select from:"

           GOTO LST

DO         WRITE " ",$EXTRACT($PIECE(Y,"^"),7,$LENGTH($PIECE(Y,"^"))),!

           SET DR=$PIECE($TEXT(OPT+A),"^",4)

           SET F=$PIECE(Y,"^",3)

ASK        WRITE !

           SET (DIC,DIE,DLAYGO)=F

           SET DIC(0)="AEQLM"

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<1

               GOTO OPTS

           SET DA=+Y

           DO ^DIE

           GOTO ASK

LST        WRITE !

           FOR A=1:1

               WRITE !,?15,$PIECE($PIECE($TEXT(OPT+A),";",3),"^")

               IF $TEXT(OPT+A)=""

                   QUIT 

 +1        GOTO OPTS

OPT       ;OPTION LIST

 +1       ;;T ==> Topography Field^T^61^.01;2;3;4;6

 +2       ;;M ==> Morphology Field^M^61.1^.01;2;3;6

 +3       ;;E ==> Etiology Field^E^61.2^.01;2;7;6

 +4       ;;D ==> Disease Field^D^61.4^.01;2;3;6

 +5       ;;F ==> Function Field^F^61.3^.01;2;3;6

 +6       ;;P ==> Procedure Field^P^61.5^.01;2;3;6

 +7       ;;O ==> Occupation Field^O^61.6^.01;2;3;6