LRLSR ;SLC/RWF - REPORT SORT UTILITY ;2/5/91 14:49 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
D LRAN,PRINT,END
LRAN K ^TMP($J) Q:'$D(LRUTL) S U="^",%DT="AE" D ^%DT S LRAD=Y Q:Y<1
D LRAA W !,"LOADING" D LOAD Q
LRAA S DIC="^LRO(68,",DIC(0)="AEOQZ" D ^DIC Q:Y<1
S LRAA=+Y,^TMP($J,0,LRAA)=$P(Y,U,2) G LRAA
LOAD S LRAA=0 F S LRAA=$O(^TMP($J,0,LRAA)),LRAN=0 Q:LRAA<1 D LO1
Q
LO1 S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN<1 S X=$S($D(^(LRAN,0)):^(0),1:"")
S LRDFN=+X,LRDT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):+^(3),1:0) IF 'LRDFN W !,"BAD LRAN ENTRY: ",LRAN G LO1
S @LRUTL
G LO1
PLD S LRUTL="^TMP($J,LRDFN,LRAN,LRDT)=0" G LRAN
LDP S LRUTL="^TMP($J,LRAN,LRDT,LRDFN)=0" G LRAN
LPD S LRUTL="^TMP($J,LRAN,LRDFN,LRDT)=0" G LRAN
DLP S LRUTL="^TMP($J,LRDT,LRAN,LRDFN)=0" G LRAN
PRINT ;
END K ^TMP($J),LRUTL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLSR 822 printed Dec 13, 2024@02:16:49 Page 2
LRLSR ;SLC/RWF - REPORT SORT UTILITY ;2/5/91 14:49 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 DO LRAN
DO PRINT
DO END
LRAN KILL ^TMP($JOB)
if '$DATA(LRUTL)
QUIT
SET U="^"
SET %DT="AE"
DO ^%DT
SET LRAD=Y
if Y<1
QUIT
+1 DO LRAA
WRITE !,"LOADING"
DO LOAD
QUIT
LRAA SET DIC="^LRO(68,"
SET DIC(0)="AEOQZ"
DO ^DIC
if Y<1
QUIT
+1 SET LRAA=+Y
SET ^TMP($JOB,0,LRAA)=$PIECE(Y,U,2)
GOTO LRAA
LOAD SET LRAA=0
FOR
SET LRAA=$ORDER(^TMP($JOB,0,LRAA))
SET LRAN=0
if LRAA<1
QUIT
DO LO1
+1 QUIT
LO1 SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
if LRAN<1
QUIT
SET X=$SELECT($DATA(^(LRAN,0)):^(0),1:"")
+1 SET LRDFN=+X
SET LRDT=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):+^(3),1:0)
IF 'LRDFN
WRITE !,"BAD LRAN ENTRY: ",LRAN
GOTO LO1
+2 SET @LRUTL
+3 GOTO LO1
PLD SET LRUTL="^TMP($J,LRDFN,LRAN,LRDT)=0"
GOTO LRAN
LDP SET LRUTL="^TMP($J,LRAN,LRDT,LRDFN)=0"
GOTO LRAN
LPD SET LRUTL="^TMP($J,LRAN,LRDFN,LRDT)=0"
GOTO LRAN
DLP SET LRUTL="^TMP($J,LRDT,LRAN,LRDFN)=0"
GOTO LRAN
PRINT ;
END KILL ^TMP($JOB),LRUTL
QUIT
