LRSPS ;AVAMC/REG - CY/EM/SP PATH SEARCH LROPT SELECTOR ; 6/24/86 12:21 PM ;
;;5.2;LAB SERVICE;;Sep 27, 1994
S IOP="HOME" D ^%ZIS,XR^LRU
OPTS W !!,"Select ",LRAA(1)," Search: " R X:DTIME Q:X=""!(X[U)
F A=1:1 S Y=$P($T(OPT+A),";",3) Q:Y="" G:$E(X,1)=$P(Y,U,2) DO
W !!,"Select from:" G LST
DO W " ",$E($P(Y,U,1),7,$L($P(Y,U,1))),! S LROPT=$P(Y,U,3,4) D @LROPT G OPTS
LST W ! F A=1:1 W !,?15,$P($P($T(OPT+A),";",3),U,1) Q:$T(OPT+A)=""
G OPTS
M S S(7)="MORPHOLOGY",LRSN=61.1,V=2 D ^LRAPSM Q
D S S(7)="DISEASE",LRSN=61.4,V=1 D ^LRAPSM Q
F S S(7)="FUNCTION",LRSN=61.3,V=3 D ^LRAPSM Q
E S S(7)="ETIOLOGY",LRSN=61.2,V=2 D ^LRAPSM Q
P S S(7)="PROCEDURE",LRSN=61.5,V=4 D ^LRAPSM Q
OPT ;OPTION LIST
;;M ==> Morphology Code Search, SNOMED^M^M
;;D ==> Disease Code Search, SNOMED^D^D
;;F ==> Function Code Search, SNOMED^F^F
;;E ==> Etiology Code Search, SNOMED^E^E
;;P ==> Procedure Code Search, SNOMED^P^P
;;I ==> ICD9CM code Search^I^^LRSPSICD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSPS 967 printed Sep 23, 2025@19:56:22 Page 2
LRSPS ;AVAMC/REG - CY/EM/SP PATH SEARCH LROPT SELECTOR ; 6/24/86 12:21 PM ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 SET IOP="HOME"
DO ^%ZIS
DO XR^LRU
OPTS WRITE !!,"Select ",LRAA(1)," Search: "
READ X:DTIME
if X=""!(X[U)
QUIT
+1 FOR A=1:1
SET Y=$PIECE($TEXT(OPT+A),";",3)
if Y=""
QUIT
if $EXTRACT(X,1)=$PIECE(Y,U,2)
GOTO DO
+2 WRITE !!,"Select from:"
GOTO LST
DO WRITE " ",$EXTRACT($PIECE(Y,U,1),7,$LENGTH($PIECE(Y,U,1))),!
SET LROPT=$PIECE(Y,U,3,4)
DO @LROPT
GOTO OPTS
LST WRITE !
FOR A=1:1
WRITE !,?15,$PIECE($PIECE($TEXT(OPT+A),";",3),U,1)
if $TEXT(OPT+A)=""
QUIT
+1 GOTO OPTS
M SET S(7)="MORPHOLOGY"
SET LRSN=61.1
SET V=2
DO ^LRAPSM
QUIT
D SET S(7)="DISEASE"
SET LRSN=61.4
SET V=1
DO ^LRAPSM
QUIT
F SET S(7)="FUNCTION"
SET LRSN=61.3
SET V=3
DO ^LRAPSM
QUIT
E SET S(7)="ETIOLOGY"
SET LRSN=61.2
SET V=2
DO ^LRAPSM
QUIT
P SET S(7)="PROCEDURE"
SET LRSN=61.5
SET V=4
DO ^LRAPSM
QUIT
OPT ;OPTION LIST
+1 ;;M ==> Morphology Code Search, SNOMED^M^M
+2 ;;D ==> Disease Code Search, SNOMED^D^D
+3 ;;F ==> Function Code Search, SNOMED^F^F
+4 ;;E ==> Etiology Code Search, SNOMED^E^E
+5 ;;P ==> Procedure Code Search, SNOMED^P^P
+6 ;;I ==> ICD9CM code Search^I^^LRSPSICD
