- XWBEXMPL ;ISC-SF/VYD - RPC BROKER EXAMPLE ;07/13/2004 15:03
- ;;1.1;RPC BROKER;**22,35**;Mar 28, 1997
- ECHOSTR(RESULT,OSTRING) ;receive string and return it
- S RESULT=OSTRING
- Q
- ;
- ;
- GETLIST(RESULT,WHAT,QTY) ; -- return list
- ;WHAT - LINES or KILOBYTES, QTY - number of lines of kilobytes
- ;here the resulting list can get quite large - use global structure
- N I,J,L,V ;looping vars
- S $P(L,"-+",128)=" "
- K ^TMP($J,"XWB RESULTS") ;clean out temporary storage
- I WHAT="LINES" D ;lines requested
- . F I=1:1:QTY D
- . . S V="Line #"_I,V=V_$S(I'>$L(V):"",1:$E(L,1,$S(QTY+$L(V)>255:255-$L(V),1:QTY-$L(V))))
- . . S ^TMP($J,"XWB RESULTS",I)=V
- . . ;S ^TMP($J,"XWB RESULTS",I)="Line #"_I
- ;
- E D ;kilobytes of data requested
- . F I=1:1:QTY D
- . . F J=1:1:64 D ;64 lines * 16 chars = 1K
- . . . S ^TMP($J,"XWB RESULTS",I*100+J)=$E(I_"-Kilobyte******",1,16)
- ;
- S RESULT=$NA(^TMP($J,"XWB RESULTS")) ;give Broker data root
- Q
- ;
- ;
- WPTEXT(RESULT) ;return word processing text
- N TEXT
- ;use DBS call to get REMOTE PROCEDURE file description
- D FILE^DID(8994,"","DESCRIPTION","TEXT")
- M RESULT=TEXT("DESCRIPTION")
- Q
- ;
- ;
- SORTNUM(RESULT,DIRCTN,ARRAY) ; -- sort numbers and return sorted
- ;DIRCTN - direction to sort in HI or LO
- ;ARRAY - array of numbers to sort
- ;S $ECODE=",U411," Q
- N I,J
- IF DIRCTN="LO" D ;sort LOW -> HIGH
- . S I="" F S I=$O(ARRAY(I)) Q:I="" S J=ARRAY(I) D
- . . S RESULT(J)=J
- . . S JLIN=$G(JLIN)+1,^TMP("JLI",JLIN)=I_U_J
- E D ;sort HIGH -> LOW
- . S I="" F S I=$O(ARRAY(I)) Q:I="" S J=ARRAY(I) D
- . . S RESULT(99999999-J)=J
- Q
- ;
- GSORT(RESULT,DIRCTN,ROOT) ; -- Sort numbers in a global array
- ;DIRCTN - direction to sort in HI or LO
- ;ROOT - Closed Root of the Global array of numbers to sort
- ;Data is in ^TMP("XWB",$J,n)
- N I,V K ^TMP($J)
- IF DIRCTN="LO" D ;sort LOW -> HIGH
- . S I="" F S I=$O(@ROOT@(I)) Q:I="" D
- . . S V=$G(@ROOT@(I)) I $L(V) S ^TMP($J,V)=V
- E D ;sort HIGH -> LOW
- . S I="" F S I=$O(@ROOT@(I)) Q:I="" D
- . . S V=$G(@ROOT@(I)) I $L(V) S ^TMP($J,99999999-V)=V
- S RESULT=$NA(^TMP($J))
- M ^RWF($J)=@ROOT
- Q
- ;
- BIGTXT(RESULT,ARRAY) ;-- Accept a big text block.
- ;Return count. char^lines
- N CC,LC,I
- S CC=0,LC=0,I=""
- F S I=$O(ARRAY(I)) Q:I="" S LC=LC+1,CC=CC+$L(ARRAY(I))
- K ^TMP($J) M ^TMP($J)=ARRAY
- S RESULT=CC_"^"_LC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBEXMPL 2440 printed Feb 19, 2025@00:03:37 Page 2
- XWBEXMPL ;ISC-SF/VYD - RPC BROKER EXAMPLE ;07/13/2004 15:03
- +1 ;;1.1;RPC BROKER;**22,35**;Mar 28, 1997
- ECHOSTR(RESULT,OSTRING) ;receive string and return it
- +1 SET RESULT=OSTRING
- +2 QUIT
- +3 ;
- +4 ;
- GETLIST(RESULT,WHAT,QTY) ; -- return list
- +1 ;WHAT - LINES or KILOBYTES, QTY - number of lines of kilobytes
- +2 ;here the resulting list can get quite large - use global structure
- +3 ;looping vars
- NEW I,J,L,V
- +4 SET $PIECE(L,"-+",128)=" "
- +5 ;clean out temporary storage
- KILL ^TMP($JOB,"XWB RESULTS")
- +6 ;lines requested
- IF WHAT="LINES"
- Begin DoDot:1
- +7 FOR I=1:1:QTY
- Begin DoDot:2
- +8 SET V="Line #"_I
- SET V=V_$SELECT(I'>$LENGTH(V):"",1:$EXTRACT(L,1,$SELECT(QTY+$LENGTH(V)>255:255-$LENGTH(V),1:QTY-$LENGTH(V))))
- +9 SET ^TMP($JOB,"XWB RESULTS",I)=V
- +10 ;S ^TMP($J,"XWB RESULTS",I)="Line #"_I
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 ;kilobytes of data requested
- IF '$TEST
- Begin DoDot:1
- +13 FOR I=1:1:QTY
- Begin DoDot:2
- +14 ;64 lines * 16 chars = 1K
- FOR J=1:1:64
- Begin DoDot:3
- +15 SET ^TMP($JOB,"XWB RESULTS",I*100+J)=$EXTRACT(I_"-Kilobyte******",1,16)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 ;
- +17 ;give Broker data root
- SET RESULT=$NAME(^TMP($JOB,"XWB RESULTS"))
- +18 QUIT
- +19 ;
- +20 ;
- WPTEXT(RESULT) ;return word processing text
- +1 NEW TEXT
- +2 ;use DBS call to get REMOTE PROCEDURE file description
- +3 DO FILE^DID(8994,"","DESCRIPTION","TEXT")
- +4 MERGE RESULT=TEXT("DESCRIPTION")
- +5 QUIT
- +6 ;
- +7 ;
- SORTNUM(RESULT,DIRCTN,ARRAY) ; -- sort numbers and return sorted
- +1 ;DIRCTN - direction to sort in HI or LO
- +2 ;ARRAY - array of numbers to sort
- +3 ;S $ECODE=",U411," Q
- +4 NEW I,J
- +5 ;sort LOW -> HIGH
- IF DIRCTN="LO"
- Begin DoDot:1
- +6 SET I=""
- FOR
- SET I=$ORDER(ARRAY(I))
- if I=""
- QUIT
- SET J=ARRAY(I)
- Begin DoDot:2
- +7 SET RESULT(J)=J
- +8 SET JLIN=$GET(JLIN)+1
- SET ^TMP("JLI",JLIN)=I_U_J
- End DoDot:2
- End DoDot:1
- +9 ;sort HIGH -> LOW
- IF '$TEST
- Begin DoDot:1
- +10 SET I=""
- FOR
- SET I=$ORDER(ARRAY(I))
- if I=""
- QUIT
- SET J=ARRAY(I)
- Begin DoDot:2
- +11 SET RESULT(99999999-J)=J
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- GSORT(RESULT,DIRCTN,ROOT) ; -- Sort numbers in a global array
- +1 ;DIRCTN - direction to sort in HI or LO
- +2 ;ROOT - Closed Root of the Global array of numbers to sort
- +3 ;Data is in ^TMP("XWB",$J,n)
- +4 NEW I,V
- KILL ^TMP($JOB)
- +5 ;sort LOW -> HIGH
- IF DIRCTN="LO"
- Begin DoDot:1
- +6 SET I=""
- FOR
- SET I=$ORDER(@ROOT@(I))
- if I=""
- QUIT
- Begin DoDot:2
- +7 SET V=$GET(@ROOT@(I))
- IF $LENGTH(V)
- SET ^TMP($JOB,V)=V
- End DoDot:2
- End DoDot:1
- +8 ;sort HIGH -> LOW
- IF '$TEST
- Begin DoDot:1
- +9 SET I=""
- FOR
- SET I=$ORDER(@ROOT@(I))
- if I=""
- QUIT
- Begin DoDot:2
- +10 SET V=$GET(@ROOT@(I))
- IF $LENGTH(V)
- SET ^TMP($JOB,99999999-V)=V
- End DoDot:2
- End DoDot:1
- +11 SET RESULT=$NAME(^TMP($JOB))
- +12 MERGE ^RWF($JOB)=@ROOT
- +13 QUIT
- +14 ;
- BIGTXT(RESULT,ARRAY) ;-- Accept a big text block.
- +1 ;Return count. char^lines
- +2 NEW CC,LC,I
- +3 SET CC=0
- SET LC=0
- SET I=""
- +4 FOR
- SET I=$ORDER(ARRAY(I))
- if I=""
- QUIT
- SET LC=LC+1
- SET CC=CC+$LENGTH(ARRAY(I))
- +5 KILL ^TMP($JOB)
- MERGE ^TMP($JOB)=ARRAY
- +6 SET RESULT=CC_"^"_LC
- +7 QUIT
