- FSCRPCOS ;SLC/STAFF-NOIS RPC Sort ;2/10/97 14:47
- ;;1.1;NOIS;;Sep 06, 1998
- ;
- SORT(IN,OUT) ; from FSCRPX (RPCSort)
- ; SORT(seq #) = zero node of field
- ; SORT(sort seq #,"D") = "" (exists if field is to be sorted in descending order)
- N CALL,CHECK,CNT,DA,DESCEND,DIC,DIQ,DR,FLD,GBL,LASTCNT,LEN,LINE,LNUM,NUM,SORT,TMPSORT,TYPE,VAL,VALUE K DIQ,SORT,VALUE
- S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
- .S SORT(NUM)=$P(LINE,U,2,99)
- .I $P(LINE,U)="D" S SORT(NUM,"D")=""
- I '$O(SORT(0)) Q
- 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
- 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 CURRENT LIST",$J,"C",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 CURRENT LIST",$J),DIC,DIQ,VALUE
- S 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
- .S LNUM=LNUM+1
- .S (^TMP("FSCRPC",$J,"OUTPUT",LNUM),^TMP("FSC CURRENT LIST",$J,LNUM+1000))=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
- .S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM+1000
- K ^TMP("FSC SORT",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCOS 1909 printed Jan 18, 2025@03:20:53 Page 2
- FSCRPCOS ;SLC/STAFF-NOIS RPC Sort ;2/10/97 14:47
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- SORT(IN,OUT) ; from FSCRPX (RPCSort)
- +1 ; SORT(seq #) = zero node of field
- +2 ; SORT(sort seq #,"D") = "" (exists if field is to be sorted in descending order)
- +3 NEW CALL,CHECK,CNT,DA,DESCEND,DIC,DIQ,DR,FLD,GBL,LASTCNT,LEN,LINE,LNUM,NUM,SORT,TMPSORT,TYPE,VAL,VALUE
- KILL DIQ,SORT,VALUE
- +4 SET NUM=0
- FOR
- SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
- if NUM<1
- QUIT
- SET LINE=^(NUM)
- Begin DoDot:1
- +5 SET SORT(NUM)=$PIECE(LINE,U,2,99)
- +6 IF $PIECE(LINE,U)="D"
- SET SORT(NUM,"D")=""
- End DoDot:1
- +7 IF '$ORDER(SORT(0))
- QUIT
- +8 SET DESCEND=""
- KILL ^TMP("FSC SORT",$JOB)
- +9 FOR CNT=1:1
- if '$DATA(SORT(CNT))
- QUIT
- SET LASTCNT=CNT
- IF $DATA(SORT(CNT,"D"))
- SET DESCEND=DESCEND_CNT_","
- +10 SET LEN=60\LASTCNT
- +11 SET DR=""
- SET CNT=0
- FOR
- SET CNT=$ORDER(SORT(CNT))
- if CNT<1
- QUIT
- SET DR=DR_$PIECE(SORT(CNT),U,8)_";"
- +12 SET DIC=7100
- SET DIQ="VALUE"
- SET DIQ(0)="IE"
- +13 SET CALL=0
- FOR
- SET CALL=$ORDER(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
- if CALL<1
- QUIT
- Begin DoDot:1
- +14 SET DA=CALL
- KILL VALUE
- DO EN^DIQ1
- +15 SET GBL="^TMP(""FSC SORT"",$J"
- SET CNT=0
- FOR
- SET CNT=$ORDER(SORT(CNT))
- if CNT<1
- QUIT
- Begin DoDot:2
- +16 SET FLD=$PIECE(SORT(CNT),U,8)
- SET TYPE=$PIECE(SORT(CNT),U,3)
- +17 SET VAL=VALUE(7100,CALL,FLD,$SELECT(TYPE["D":"I",1:"E"))
- +18 Begin DoDot:3
- +19 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
- +20 SET VAL=$$UP^XLFSTR(VAL)
- IF DESCEND[(CNT_",")
- SET VAL=$TRANSLATE(VAL,"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ","9876543210ZYXWVUTSRQPONMLKJIHGFEDCBA")
- End DoDot:3
- +21 SET VAL=""""_$SELECT(DESCEND[(CNT_",")&'$LENGTH(VAL):"Z",1:" ")_$EXTRACT(VAL,1,LEN)_""""
- +22 SET GBL=GBL_","_VAL
- +23 IF '$ORDER(SORT(CNT))
- SET GBL=GBL_","_CALL_")"
- SET @GBL=CALL
- End DoDot:2
- End DoDot:1
- +24 KILL ^TMP("FSC CURRENT LIST",$JOB),DIC,DIQ,VALUE
- +25 SET LNUM=0
- +26 SET TMPSORT="^TMP(""FSC SORT"",$J)"
- SET CHECK="^TMP(""FSC SORT"","_$JOB_",""z"""
- +27 FOR
- SET TMPSORT=$QUERY(@TMPSORT)
- if TMPSORT]CHECK
- QUIT
- SET CALL=@TMPSORT
- Begin DoDot:1
- +28 SET LNUM=LNUM+1
- +29 SET (^TMP("FSCRPC",$JOB,"OUTPUT",LNUM),^TMP("FSC CURRENT LIST",$JOB,LNUM+1000))=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
- +30 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=LNUM+1000
- End DoDot:1
- +31 KILL ^TMP("FSC SORT",$JOB)
- +32 QUIT