Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XOBVLT

XOBVLT.m

Go to the documentation of this file. 
  1. XOBVLT ;; mjk/alb - VistALink Tester  ; 07/27/2002  13:00
  1.  ;;1.6;VistALink;;May 08, 2009;Build 15
  1.  ;Per VHA directive 2004-038, this routine should not be modified.
  1.  QUIT
  1.  ;
  1.  ; ----------------------------------------------------------
  1.  ;                 XOB Remote Procedure Testers
  1.  ; ----------------------------------------------------------
  1.  ; 
  1. PINGRP(XOBY) ; -- rpc: XOBV TEST PING
  1.  SET XOBY="Ping Successful!"
  1.  QUIT
  1.  ;
  1. STRRP(XOBY,XOBSTR) ; -- rpc: XOBV TEST STRING
  1.  SET XOBY="Returned Input Value: "_XOBSTR
  1.  QUIT
  1.  ;
  1. XMLRP(XOBY) ; -- rpc: XOBV TEST XML RESULTS
  1.  ; -- send back XML node
  1.  SET XOBY="<?xml version='1.0' encoding='utf-8' ?>"
  1.  SET XOBY=XOBY_"<fruits>"
  1.  SET XOBY=XOBY_"   <fruit color='yellow' >banana</fruit>"
  1.  SET XOBY=XOBY_"   <fruit color='red' >apple</fruit>"
  1.  SET XOBY=XOBY_"   <fruit color='orange' >orange</fruit>"
  1.  SET XOBY=XOBY_"</fruits>"
  1.  QUIT
  1.  ;
  1. LARRRP(XOBY,XOBARR) ; -- rpc: XOBV TEST LOCAL ARRAY
  1.  NEW XOBX,XOBLINE
  1.  SET XOBLINE=0
  1.  SET XOBX="" FOR  SET XOBX=$ORDER(XOBARR(XOBX)) QUIT:XOBX=""  DO
  1.  . SET XOBLINE=XOBLINE+1
  1.  . SET XOBY(XOBLINE)=XOBX_" / "_XOBARR(XOBX)
  1.  QUIT
  1.  ;
  1. MSUBS(XOBY,XOBARR) ; -- rpc: XOBV TEST MULTIPLE SUBSCRIPTS
  1.  NEW XOBX,XOBLINE
  1.  SET XOBLINE=0
  1.  SET XOBX="" FOR  SET XOBX=$ORDER(XOBARR("FRUIT",XOBX)) QUIT:XOBX=""  DO
  1.  . SET XOBLINE=XOBLINE+1
  1.  . SET XOBY(XOBLINE)=XOBX_" / "_XOBARR("FRUIT",XOBX)
  1.  QUIT
  1.  ;
  1. MARRAYS(XOBY,XOBARR,XOBARR2,XOBARR3) ; -- rpc: XOBV TEST MULT ARRAY PARAMS
  1.  NEW XOBX,XOBLINE
  1.  SET XOBLINE=0
  1.  SET XOBX="" FOR  SET XOBX=$ORDER(XOBARR(XOBX)) QUIT:XOBX=""  DO 
  1.  . SET XOBLINE=XOBLINE+1
  1.  . SET XOBY(XOBLINE)=XOBLINE_" / "_XOBARR(XOBX)
  1.  SET XOBX="" FOR  SET XOBX=$ORDER(XOBARR2(XOBX)) QUIT:XOBX=""  DO 
  1.  . SET XOBLINE=XOBLINE+1
  1.  . SET XOBY(XOBLINE)=XOBLINE_" / "_XOBARR2(XOBX)
  1.  SET XOBX="" FOR  SET XOBX=$ORDER(XOBARR3(XOBX)) QUIT:XOBX=""  DO 
  1.  . SET XOBLINE=XOBLINE+1
  1.  . SET XOBY(XOBLINE)=XOBLINE_" / "_XOBARR3(XOBX)
  1.  QUIT  ;
  1.  ;
  1. GARRRP(XOBY,XOBARR) ; -- rpc: XOBV TEST GLOBAL ARRAY
  1.  SET XOBY=$NAME(^TMP("XOB VL TEST",$JOB))
  1.  KILL @XOBY
  1.  MERGE @XOBY=XOBARR
  1.  QUIT
  1.  ;
  1. RPCRP(XOBY,XOBSTR) ; -- rpc: XOBV TEST RPC LIST
  1.  ;
  1.  ;-- List all RPC's starting with same string (i.e. namespace)
  1.  ;
  1.  ;  Input:
  1.  ;    XOBSTR  -   string to look up (ex. "XOBV" will look up all RPCs starting with XOBV)
  1.  ;
  1.  ; Output:
  1.  ;    XOBY    -   output array, passed by reference, defined as:
  1.  ;                  XOBY(0)   contains either error message or header line
  1.  ;                  XOBY(1-n) contains data line
  1.  ;
  1.  IF $LENGTH($GET(XOBSTR))=0 SET XOBY(0)="<no RPC prefix defined>" QUIT
  1.  SET XOBY(0)="RPCs Starting with '"_XOBSTR_"'..."
  1.  DO LIST^DIC(8994,"","","","",XOBSTR,XOBSTR,"","","","")
  1.  SET XOBY(0)=XOBY(0)_" ("_+^TMP("DILIST",$JOB,0)_") entries found."
  1.  MERGE XOBY=^TMP("DILIST",$JOB,1)
  1.  KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
  1.  QUIT
  1.  ;
  1.  ;
  1. NOCNTXT(XOBY) ; -- rpc: XOB VL NOT IN CONTEXT TEST
  1.  ; This code is not used.
  1.  ; See REMOTE PROCEDURE file entry for description why.
  1.  QUIT ""
  1.  ;
  1. WPRP(XOBY) ; -- rpc: XOBV TEST WORD PROCESSING
  1.  NEW I,X
  1.  FOR I=1:1 SET X=$PIECE($TEXT(GA+I),";;",2) QUIT:X="$$END$$"  SET XOBY(I)=X
  1.  QUIT
  1.  ;
  1. GA ;; -- 'Gettysburg Address' text
  1.  ;;==================
  1.  ;;Gettysburg Address
  1.  ;;==================
  1.  ;;Four score and seven years ago our fathers brought forth, 
  1.  ;;upon this continent, a new nation, conceived in liberty, 
  1.  ;;and dedicated to the proposition that 'all men are 
  1.  ;;created equal'. 
  1.  ;; 
  1.  ;;Now we are engaged in a great civil war, testing whether that 
  1.  ;;nation, or any nation so conceived, and so dedicated, can long 
  1.  ;;endure. We are met on a great battle field of that war. We come 
  1.  ;;to dedicate a portion of it, as a final resting place for those 
  1.  ;;who died here, that the nation might live. This we may, in all 
  1.  ;;propriety do. But, in a larger sense, we can not dedicate -- we 
  1.  ;;can not consecrate -- we can not hallow, this ground -- The brave 
  1.  ;;men, living and dead, who struggled here, have hallowed it, far 
  1.  ;;above our poor power to add or detract. The world will little 
  1.  ;;note,nor long remember what we say here; while it can never 
  1.  ;;forget what they did here."
  1.  ;; 
  1.  ;;It is rather for us, the living, we here be dedicated to the great 
  1.  ;;task remaining before us -- that, from these honored dead we take 
  1.  ;;increased devotion to that cause for which they here, gave the 
  1.  ;;last full measure of devotion -- that we here highly resolve these 
  1.  ;;dead shall not have died in vain; that the nation, shall have a 
  1.  ;;new birth of freedom, and that government of the people by the 
  1.  ;;people for the people, shall not perish from the earth.
  1.  ;;$$END$$
  1.  ;
  1. GNODERP(XOBY,XOBSTR) ; -- rpc: XOBV TEST GLOBAL NODE
  1.  SET XOBY=$NAME(^TMP("XOB VL TEST",$JOB))
  1.  KILL @XOBY
  1.  SET @XOBY="Returned Input Value: "_XOBSTR
  1.  QUIT
  1.  ;
  1. EXTASCII(XOBY,XOBSTR) ; -- rpc: XOBV TEST EXTENDED ASCII
  1.  ; return value (array): 
  1.  ; XOBY(1): 0^XOBSTR if didn't get ASCII extended chars 128-255, 1^XOBSTR if did
  1.  ; XOBY(128-255): ASCII value expected^ASCII value received
  1.  ; 
  1.  NEW XOBI,XOBCH,XOBPOS
  1.  SET XOBY(1)="0^"_XOBSTR
  1.  QUIT:$LENGTH(XOBSTR)'=123  ;(128-255, but 5 chars undefined)
  1.  SET XOBY(1)="1^"_XOBSTR
  1.  SET XOBPOS=1
  1.  FOR XOBI=128,130:1:140,142,145:1:156,158:1:255 DO
  1.  .SET XOBCH=$EXTRACT(XOBSTR,XOBPOS)
  1.  .SET XOBY(XOBI)=XOBI_"^"_$ASCII(XOBCH)
  1.  .SET:$ASCII(XOBCH)'=(XOBI) XOBY(1)="0^"_XOBSTR,XOBY(XOBI)=XOBY(XOBI)_"^PROBLEM"
  1.  .SET XOBPOS=XOBPOS+1
  1.  QUIT
  1.  ;