| [613] | 1 | LRUSE ;AVAMC/REG - ENTER/EDIT SNOMED FIELDS ; 6/2/86 9:12 AM ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | OPTS R !!,"Select SNOMED FIELD to edit: ",X:DTIME Q:X=""!(X["^")
|
|---|
| 4 | F A=1:1 S Y=$P($T(OPT+A),";",3) Q:Y="" G:$E(X,1)=$P(Y,"^",2) DO
|
|---|
| 5 | W !!,"Select from:" G LST
|
|---|
| 6 | DO W " ",$E($P(Y,"^"),7,$L($P(Y,"^"))),! S DR=$P($T(OPT+A),"^",4),F=$P(Y,"^",3)
|
|---|
| 7 | 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
|
|---|
| 8 | LST W ! F A=1:1 W !,?15,$P($P($T(OPT+A),";",3),"^") Q:$T(OPT+A)=""
|
|---|
| 9 | G OPTS
|
|---|
| 10 | OPT ;OPTION LIST
|
|---|
| 11 | ;;T ==> Topography Field^T^61^.01;2;3;4;6
|
|---|
| 12 | ;;M ==> Morphology Field^M^61.1^.01;2;3;6
|
|---|
| 13 | ;;E ==> Etiology Field^E^61.2^.01;2;7;6
|
|---|
| 14 | ;;D ==> Disease Field^D^61.4^.01;2;3;6
|
|---|
| 15 | ;;F ==> Function Field^F^61.3^.01;2;3;6
|
|---|
| 16 | ;;P ==> Procedure Field^P^61.5^.01;2;3;6
|
|---|
| 17 | ;;O ==> Occupation Field^O^61.6^.01;2;3;6
|
|---|
