- LRFNDLOC ;SLC/CJS - RETURN A LOCATION FROM ^LRO(69,LRODT,1,"AR",LRLLOC,SN) ;2/8/91 08:42 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- S:'$D(DIC("A")) DIC("A")="Select PATIENT LOCATION: "
- LOOP 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
- S:X?.N X=X_$C(31)
- SOME S Y=$O(^LRO(69,LRODT,1,"AC",X)) G LALL:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC)
- 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
- 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["^"
- S %=%-1 W !,"CHOOSE 1-",%,": " R X:DTIME G LALL:X["?" G LOOP:X["^"!(X="")
- I X\1'=+X!(X<1)!(X>%) W " ??",$C(7),! G LOOP
- S LRLLOC=%(X) G LEND
- LALL 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["^"
- G LOOP
- LEND K %,X,Y Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRFNDLOC 1008 printed Mar 13, 2025@21:19:10 Page 2
- LRFNDLOC ;SLC/CJS - RETURN A LOCATION FROM ^LRO(69,LRODT,1,"AR",LRLLOC,SN) ;2/8/91 08:42 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +2 if '$DATA(DIC("A"))
- SET DIC("A")="Select PATIENT LOCATION: "
- LOOP SET LRLLOC=""
- WRITE !,DIC("A")
- READ X:DTIME
- SET LRLLOC=X
- if X["^"!(X="")!(X'?.ANP)
- GOTO LEND
- if X["?"
- GOTO LALL
- IF $DATA(^LRO(69,LRODT,1,"AC",X))
- SET LRLLOC=X
- GOTO LEND
- +1 if X?.N
- SET X=X_$CHAR(31)
- SOME SET Y=$ORDER(^LRO(69,LRODT,1,"AC",X))
- if Y=""!($EXTRACT(Y,1,$LENGTH(LRLLOC))'=LRLLOC)
- GOTO LALL
- +1 SET %=$ORDER(^LRO(69,LRODT,1,"AC",Y))
- IF $EXTRACT(%,1,$LENGTH(LRLLOC))'=LRLLOC
- WRITE $EXTRACT(Y,$LENGTH(LRLLOC)+1,$LENGTH(Y))
- SET LRLLOC=Y
- GOTO LEND
- +2 KILL %
- SET Y=X
- FOR %=1:1
- SET Y=$ORDER(^LRO(69,LRODT,1,"AC",Y))
- if Y=""!($EXTRACT(Y,1,$LENGTH(LRLLOC))'=LRLLOC)
- QUIT
- SET %(%)=Y
- WRITE !,?5,%,?9,Y
- IF '(%#10)
- READ !,"Press ""^"" to quit ",X:DTIME
- if X["^"
- QUIT
- +3 SET %=%-1
- WRITE !,"CHOOSE 1-",%,": "
- READ X:DTIME
- if X["?"
- GOTO LALL
- if X["^"!(X="")
- GOTO LOOP
- +4 IF X\1'=+X!(X<1)!(X>%)
- WRITE " ??",$CHAR(7),!
- GOTO LOOP
- +5 SET LRLLOC=%(X)
- GOTO LEND
- LALL SET Y=""
- WRITE !,"CHOOSE FROM:"
- FOR %=1:1
- SET Y=$ORDER(^LRO(69,LRODT,1,"AC",Y))
- if Y=""
- QUIT
- WRITE !,?5,Y
- IF '(%#10)
- READ !,"Press ""^"" to quit ",X:DTIME
- if X["^"
- QUIT
- +1 GOTO LOOP
- LEND KILL %,X,Y
- QUIT
