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 Apr 09, 2024@21:39:30 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
