source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRFNDLOC.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 994 bytes
Line 
1LRFNDLOC ;SLC/CJS - RETURN A LOCATION FROM ^LRO(69,LRODT,1,"AR",LRLLOC,SN) ;2/8/91 08:42 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 S:'$D(DIC("A")) DIC("A")="Select PATIENT LOCATION: "
4LOOP S LRLLOC="" W !,DIC("A") R X:DTIME S LRLLOC=X G LEND:X["^"!(X="")!(X'?.ANP),LALL:X["?" I $D(^LRO(69,LRODT,1,"AC",X)) S LRLLOC=X G LEND
5 S:X?.N X=X_$C(31)
6SOME S Y=$O(^LRO(69,LRODT,1,"AC",X)) G LALL:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC)
7 S %=$O(^LRO(69,LRODT,1,"AC",Y)) I $E(%,1,$L(LRLLOC))'=LRLLOC W $E(Y,$L(LRLLOC)+1,$L(Y)) S LRLLOC=Y G LEND
8 K % S Y=X F %=1:1 S Y=$O(^LRO(69,LRODT,1,"AC",Y)) Q:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC) S %(%)=Y W !,?5,%,?9,Y I '(%#10) R !,"Press ""^"" to quit ",X:DTIME Q:X["^"
9 S %=%-1 W !,"CHOOSE 1-",%,": " R X:DTIME G LALL:X["?" G LOOP:X["^"!(X="")
10 I X\1'=+X!(X<1)!(X>%) W " ??",$C(7),! G LOOP
11 S LRLLOC=%(X) G LEND
12LALL S Y="" W !,"CHOOSE FROM:" F %=1:1 S Y=$O(^LRO(69,LRODT,1,"AC",Y)) Q:Y="" W !,?5,Y I '(%#10) R !,"Press ""^"" to quit ",X:DTIME Q:X["^"
13 G LOOP
14LEND K %,X,Y Q
Note: See TracBrowser for help on using the repository browser.