- LRULA ;AVAMC/REG - EDIT LOCATION ;3/9/94 13:28 ;
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRULA 858 printed Jan 18, 2025@03:22:17 Page 2
- LRULA ;AVAMC/REG - EDIT LOCATION ;3/9/94 13:28 ;
- +1 ;;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