FSCUS ;SLC/STAFF-NOIS Utilities Sort ;4/22/94 12:36
;;1.1;NOIS;;Sep 06, 1998
;
SORT(SORT) ; from FSCLMPOS, FSCRPTS
; sorts ^TMP("FSC LIST CALLS",$J, globals using a sequence of fields
; SORT(seq #) = zero node of field
; SORT(sort seq #,"D") = "" (exists if field is to be sorted in descending order)
I '$O(SORT(0)) Q
N CALL,CHECK,CNT,DA,DESCEND,DIC,DIQ,DR,FLD,GBL,LASTCNT,LEN,LNUM,TMPSORT,TYPE,VAL,VALUE K DIQ,VALUE
S DESCEND="" K ^TMP("FSC SORT",$J)
F CNT=1:1 Q:'$D(SORT(CNT)) S LASTCNT=CNT I $D(SORT(CNT,"D")) S DESCEND=DESCEND_CNT_","
S LEN=60\LASTCNT I '$G(FSCDEV) W !
S DR="",CNT=0 F S CNT=$O(SORT(CNT)) Q:CNT<1 S DR=DR_$P(SORT(CNT),U,8)_";"
S DIC=7100,DIQ="VALUE",DIQ(0)="IE"
S CALL=0 F S CALL=$O(^TMP("FSC LIST CALLS",$J,"CX",CALL)) Q:CALL<1 D
.S DA=CALL K VALUE D EN^DIQ1
.S GBL="^TMP(""FSC SORT"",$J",CNT=0 F S CNT=$O(SORT(CNT)) Q:CNT<1 D
..S FLD=$P(SORT(CNT),U,8),TYPE=$P(SORT(CNT),U,3)
..S VAL=VALUE(7100,CALL,FLD,$S(TYPE["D":"I",1:"E"))
..D
...I TYPE["D"!(TYPE["N") S VAL=$S(VAL'<1:+VAL,$E(VAL)'=".":+VAL,VAL?1P1N.N:"0"_VAL,1:+VAL) I DESCEND[(CNT_",") S VAL=9999999-VAL Q
...S VAL=$$UP^XLFSTR(VAL) I DESCEND[(CNT_",") S VAL=$TR(VAL,"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ","9876543210ZYXWVUTSRQPONMLKJIHGFEDCBA")
..S VAL=""""_$S(DESCEND[(CNT_",")&'$L(VAL):"Z",1:" ")_$E(VAL,1,LEN)_""""
..S GBL=GBL_","_VAL
..I '$O(SORT(CNT)) S GBL=GBL_","_CALL_")" S @GBL=CALL
K ^TMP("FSC LIST CALLS",$J),DIC,DIQ,VALUE
S VALMCNT=0,LNUM=0
S TMPSORT="^TMP(""FSC SORT"",$J)",CHECK="^TMP(""FSC SORT"","_$J_",""z"""
F S TMPSORT=$Q(@TMPSORT) Q:TMPSORT]CHECK S CALL=@TMPSORT D SETUP^FSCLML I (VALMCNT#10)=0 D CHECK^FSCLML(.VALMQUIT) I $D(VALMQUIT) S VALMBCK="Q" Q
K ^TMP("FSC SORT",$J)
I $D(VALMQUIT) Q
S ^TMP("FSC LIST CALLS",$J)=LNUM_U_VALMCNT
S VALMBG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCUS 1825 printed Apr 09, 2024@21:22:37 Page 2
FSCUS ;SLC/STAFF-NOIS Utilities Sort ;4/22/94 12:36
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
SORT(SORT) ; from FSCLMPOS, FSCRPTS
+1 ; sorts ^TMP("FSC LIST CALLS",$J, globals using a sequence of fields
+2 ; SORT(seq #) = zero node of field
+3 ; SORT(sort seq #,"D") = "" (exists if field is to be sorted in descending order)
+4 IF '$ORDER(SORT(0))
QUIT
+5 NEW CALL,CHECK,CNT,DA,DESCEND,DIC,DIQ,DR,FLD,GBL,LASTCNT,LEN,LNUM,TMPSORT,TYPE,VAL,VALUE
KILL DIQ,VALUE
+6 SET DESCEND=""
KILL ^TMP("FSC SORT",$JOB)
+7 FOR CNT=1:1
if '$DATA(SORT(CNT))
QUIT
SET LASTCNT=CNT
IF $DATA(SORT(CNT,"D"))
SET DESCEND=DESCEND_CNT_","
+8 SET LEN=60\LASTCNT
IF '$GET(FSCDEV)
WRITE !
+9 SET DR=""
SET CNT=0
FOR
SET CNT=$ORDER(SORT(CNT))
if CNT<1
QUIT
SET DR=DR_$PIECE(SORT(CNT),U,8)_";"
+10 SET DIC=7100
SET DIQ="VALUE"
SET DIQ(0)="IE"
+11 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
if CALL<1
QUIT
Begin DoDot:1
+12 SET DA=CALL
KILL VALUE
DO EN^DIQ1
+13 SET GBL="^TMP(""FSC SORT"",$J"
SET CNT=0
FOR
SET CNT=$ORDER(SORT(CNT))
if CNT<1
QUIT
Begin DoDot:2
+14 SET FLD=$PIECE(SORT(CNT),U,8)
SET TYPE=$PIECE(SORT(CNT),U,3)
+15 SET VAL=VALUE(7100,CALL,FLD,$SELECT(TYPE["D":"I",1:"E"))
+16 Begin DoDot:3
+17 IF TYPE["D"!(TYPE["N")
SET VAL=$SELECT(VAL'<1:+VAL,$EXTRACT(VAL)'=".":+VAL,VAL?1P1N.N:"0"_VAL,1:+VAL)
IF DESCEND[(CNT_",")
SET VAL=9999999-VAL
QUIT
+18 SET VAL=$$UP^XLFSTR(VAL)
IF DESCEND[(CNT_",")
SET VAL=$TRANSLATE(VAL,"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ","9876543210ZYXWVUTSRQPONMLKJIHGFEDCBA")
End DoDot:3
+19 SET VAL=""""_$SELECT(DESCEND[(CNT_",")&'$LENGTH(VAL):"Z",1:" ")_$EXTRACT(VAL,1,LEN)_""""
+20 SET GBL=GBL_","_VAL
+21 IF '$ORDER(SORT(CNT))
SET GBL=GBL_","_CALL_")"
SET @GBL=CALL
End DoDot:2
End DoDot:1
+22 KILL ^TMP("FSC LIST CALLS",$JOB),DIC,DIQ,VALUE
+23 SET VALMCNT=0
SET LNUM=0
+24 SET TMPSORT="^TMP(""FSC SORT"",$J)"
SET CHECK="^TMP(""FSC SORT"","_$JOB_",""z"""
+25 FOR
SET TMPSORT=$QUERY(@TMPSORT)
if TMPSORT]CHECK
QUIT
SET CALL=@TMPSORT
DO SETUP^FSCLML
IF (VALMCNT#10)=0
DO CHECK^FSCLML(.VALMQUIT)
IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+26 KILL ^TMP("FSC SORT",$JOB)
+27 IF $DATA(VALMQUIT)
QUIT
+28 SET ^TMP("FSC LIST CALLS",$JOB)=LNUM_U_VALMCNT
+29 SET VALMBG=1
+30 QUIT
