- LRLSR ; IHS/DIR/FJE - REPORT SORT UTILITY 2/5/91 14:49 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;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
- LRLSR ; IHS/DIR/FJE - REPORT SORT UTILITY 2/5/91 14:49 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 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