LRULA.m

LRULA ; IHS/DIR/FJE - EDIT LOCATION 3/9/94 13:28 ;

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

 ;

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

A W ! S DIC=68,DIC(0)="AEQMZ" D ^DIC K DIC G:Y=-1 END S LRAA=+Y,LRAA(1)=$P(Y,U,2),T=$P(Y(0),U,3)

D S %DT="AEQ",%DT("A")="Select Date: " D ^%DT G:Y=-1 A S LRAD=$S(T="D":Y,T="Y":$E(Y,1,3)_"0000",1:$E(Y,1,5)_"00") D D^LRU S LRD=Y I '$D(^LRO(68,LRAA,1,LRAD)) W $C(7),!,"No date for ",LRAA(1) G D

L R !!,"Select Accession Number: ",LRAN:DTIME Q:LRAN=""!(LRAN[U)  I LRAN'?1N.N W $C(7),"  Enter numbers only." G L

 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!,"Accession ",LRAN," for ",LRD," doesn't exist for ",LRAA(1) G L

 S LRX=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7) W !,"LOCATION: ",LRX," // " R X:DTIME G:'X!(X[U) A

 I '$O(^SC("C",X,0)) W $C(7),!,"LOCATION ABBREVIATION DOES NOT EXIST" G L

 I X'=LRX S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)=X

 G L

 ;

END D V^LRU Q

LRULA     ; IHS/DIR/FJE - EDIT LOCATION 3/9/94 13:28 ;

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

 +2       ;

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

A          WRITE !

           SET DIC=68

           SET DIC(0)="AEQMZ"

           DO ^DIC

           KILL DIC

           IF Y=-1

               GOTO END

           SET LRAA=+Y

           SET LRAA(1)=$PIECE(Y,U,2)

           SET T=$PIECE(Y(0),U,3)

D          SET %DT="AEQ"

           SET %DT("A")="Select Date: "

           DO ^%DT

           IF Y=-1

               GOTO A

           SET LRAD=$SELECT(T="D":Y,T="Y":$EXTRACT(Y,1,3)_"0000",1:$EXTRACT(Y,1,5)_"00")

           DO D^LRU

           SET LRD=Y

           IF '$DATA(^LRO(68,LRAA,1,LRAD))

               WRITE $CHAR(7),!,"No date for ",LRAA(1)

               GOTO D

L          READ !!,"Select Accession Number: ",LRAN:DTIME

           IF LRAN=""!(LRAN[U)

               QUIT 

           IF LRAN'?1N.N

               WRITE $CHAR(7),"  Enter numbers only."

               GOTO L

 +1        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))

               WRITE $CHAR(7),!,"Accession ",LRAN," for ",LRD," doesn't exist for ",LRAA(1)

               GOTO L

 +2        SET LRX=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)

           WRITE !,"LOCATION: ",LRX," // "

           READ X:DTIME

           IF 'X!(X[U)

               GOTO A

 +3        IF '$ORDER(^SC("C",X,0))

               WRITE $CHAR(7),!,"LOCATION ABBREVIATION DOES NOT EXIST"

               GOTO L

 +4        IF X'=LRX

               SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)=X

 +5        GOTO L

 +6       ;

END        DO V^LRU

           QUIT