source: FOIAVistA/tag/r/VISTALINK-XOBV/XOBVLT.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1XOBVLT ;; mjk/alb - VistALink Tester ; 07/27/2002 13:00
2 ;;1.5;VistALink;;Sep 09, 2005
3 ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
4 ;
5 QUIT
6 ;
7 ; ----------------------------------------------------------
8 ; XOB Remote Procedure Testers
9 ; ----------------------------------------------------------
10 ;
11PINGRP(XOBY) ; -- rpc: XOBV TEST PING
12 SET XOBY="Ping Successful!"
13 QUIT
14 ;
15STRRP(XOBY,XOBSTR) ; -- rpc: XOBV TEST STRING
16 SET XOBY="Returned Input Value: "_XOBSTR
17 QUIT
18 ;
19XMLRP(XOBY) ; -- rpc: XOBV TEST XML RESULTS
20 ; -- send back XML node
21 SET XOBY="<?xml version='1.0' encoding='utf-8' ?>"
22 SET XOBY=XOBY_"<fruits>"
23 SET XOBY=XOBY_" <fruit color='yellow' >banana</fruit>"
24 SET XOBY=XOBY_" <fruit color='red' >apple</fruit>"
25 SET XOBY=XOBY_" <fruit color='orange' >orange</fruit>"
26 SET XOBY=XOBY_"</fruits>"
27 QUIT
28 ;
29LARRRP(XOBY,XOBARR) ; -- rpc: XOBV TEST LOCAL ARRAY
30 NEW XOBX,XOBLINE
31 SET XOBLINE=0
32 SET XOBX="" FOR SET XOBX=$ORDER(XOBARR(XOBX)) QUIT:XOBX="" DO
33 . SET XOBLINE=XOBLINE+1
34 . SET XOBY(XOBLINE)=XOBX_" / "_XOBARR(XOBX)
35 QUIT
36 ;
37MSUBS(XOBY,XOBARR) ; -- rpc: XOBV TEST MULTIPLE SUBSCRIPTS
38 NEW XOBX,XOBLINE
39 SET XOBLINE=0
40 SET XOBX="" FOR SET XOBX=$ORDER(XOBARR("FRUIT",XOBX)) QUIT:XOBX="" DO
41 . SET XOBLINE=XOBLINE+1
42 . SET XOBY(XOBLINE)=XOBX_" / "_XOBARR("FRUIT",XOBX)
43 QUIT
44 ;
45MARRAYS(XOBY,XOBARR,XOBARR2,XOBARR3) ; -- rpc: XOBV TEST MULT ARRAY PARAMS
46 NEW XOBX,XOBLINE
47 SET XOBLINE=0
48 SET XOBX="" FOR SET XOBX=$ORDER(XOBARR(XOBX)) QUIT:XOBX="" DO
49 . SET XOBLINE=XOBLINE+1
50 . SET XOBY(XOBLINE)=XOBLINE_" / "_XOBARR(XOBX)
51 SET XOBX="" FOR SET XOBX=$ORDER(XOBARR2(XOBX)) QUIT:XOBX="" DO
52 . SET XOBLINE=XOBLINE+1
53 . SET XOBY(XOBLINE)=XOBLINE_" / "_XOBARR2(XOBX)
54 SET XOBX="" FOR SET XOBX=$ORDER(XOBARR3(XOBX)) QUIT:XOBX="" DO
55 . SET XOBLINE=XOBLINE+1
56 . SET XOBY(XOBLINE)=XOBLINE_" / "_XOBARR3(XOBX)
57 QUIT ;
58 ;
59GARRRP(XOBY,XOBARR) ; -- rpc: XOBV TEST GLOBAL ARRAY
60 SET XOBY=$NAME(^TMP("XOB VL TEST",$JOB))
61 KILL @XOBY
62 MERGE @XOBY=XOBARR
63 QUIT
64 ;
65RPCRP(XOBY,XOBSTR) ; -- rpc: XOBV TEST RPC LIST
66 ;
67 ;-- List all RPC's starting with same string (i.e. namespace)
68 ;
69 ; Input:
70 ; XOBSTR - string to look up (ex. "XOBV" will look up all RPCs starting with XOBV)
71 ;
72 ; Output:
73 ; XOBY - output array, passed by reference, defined as:
74 ; XOBY(0) contains either error message or header line
75 ; XOBY(1-n) contains data line
76 ;
77 IF $LENGTH($GET(XOBSTR))=0 SET XOBY(0)="<no RPC prefix defined>" QUIT
78 SET XOBY(0)="RPCs Starting with '"_XOBSTR_"'..."
79 DO LIST^DIC(8994,"","","","",XOBSTR,XOBSTR,"","","","")
80 SET XOBY(0)=XOBY(0)_" ("_+^TMP("DILIST",$JOB,0)_") entries found."
81 MERGE XOBY=^TMP("DILIST",$JOB,1)
82 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
83 QUIT
84 ;
85 ;
86NOCNTXT(XOBY) ; -- rpc: XOB VL NOT IN CONTEXT TEST
87 ; This code is not used.
88 ; See REMOTE PROCEDURE file entry for description why.
89 QUIT ""
90 ;
91WPRP(XOBY) ; -- rpc: XOBV TEST WORD PROCESSING
92 NEW I,X
93 FOR I=1:1 SET X=$PIECE($TEXT(GA+I),";;",2) QUIT:X="$$END$$" SET XOBY(I)=X
94 QUIT
95 ;
96GA ;; -- 'Gettysburg Address' text
97 ;;==================
98 ;;Gettysburg Address
99 ;;==================
100 ;;Four score and seven years ago our fathers brought forth,
101 ;;upon this continent, a new nation, conceived in liberty,
102 ;;and dedicated to the proposition that 'all men are
103 ;;created equal'.
104 ;;
105 ;;Now we are engaged in a great civil war, testing whether that
106 ;;nation, or any nation so conceived, and so dedicated, can long
107 ;;endure. We are met on a great battle field of that war. We come
108 ;;to dedicate a portion of it, as a final resting place for those
109 ;;who died here, that the nation might live. This we may, in all
110 ;;propriety do. But, in a larger sense, we can not dedicate -- we
111 ;;can not consecrate -- we can not hallow, this ground -- The brave
112 ;;men, living and dead, who struggled here, have hallowed it, far
113 ;;above our poor power to add or detract. The world will little
114 ;;note,nor long remember what we say here; while it can never
115 ;;forget what they did here."
116 ;;
117 ;;It is rather for us, the living, we here be dedicated to the great
118 ;;task remaining before us -- that, from these honored dead we take
119 ;;increased devotion to that cause for which they here, gave the
120 ;;last full measure of devotion -- that we here highly resolve these
121 ;;dead shall not have died in vain; that the nation, shall have a
122 ;;new birth of freedom, and that government of the people by the
123 ;;people for the people, shall not perish from the earth.
124 ;;$$END$$
125 ;
126GNODERP(XOBY,XOBSTR) ; -- rpc: XOBV TEST GLOBAL NODE
127 SET XOBY=$NAME(^TMP("XOB VL TEST",$JOB))
128 KILL @XOBY
129 SET @XOBY="Returned Input Value: "_XOBSTR
130 QUIT
131 ;
132EXTASCII(XOBY,XOBSTR) ; -- rpc: XOBV TEST EXTENDED ASCII
133 ; return value (array):
134 ; XOBY(1): 0^XOBSTR if didn't get ASCII extended chars 128-255, 1^XOBSTR if did
135 ; XOBY(128-255): ASCII value expected^ASCII value received
136 ;
137 NEW XOBI,XOBCH,XOBPOS
138 SET XOBY(1)="0^"_XOBSTR
139 QUIT:$LENGTH(XOBSTR)'=123 ;(128-255, but 5 chars undefined)
140 SET XOBY(1)="1^"_XOBSTR
141 SET XOBPOS=1
142 FOR XOBI=128,130:1:140,142,145:1:156,158:1:255 DO
143 .SET XOBCH=$EXTRACT(XOBSTR,XOBPOS)
144 .SET XOBY(XOBI)=XOBI_"^"_$ASCII(XOBCH)
145 .SET:$ASCII(XOBCH)'=(XOBI) XOBY(1)="0^"_XOBSTR,XOBY(XOBI)=XOBY(XOBI)_"^PROBLEM"
146 .SET XOBPOS=XOBPOS+1
147 QUIT
148 ;
Note: See TracBrowser for help on using the repository browser.