LRLSR.m

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 ---LRLSR   822     printed  Apr 09, 2024@21:06:08                                                                                                                                                                                                        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