Routine: FSCUS

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCUS   1825     printed  Feb 18, 2025@23:46:57                                                                                                                                                                                                       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

FSCUS.m