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

XWBUTL.m

Go to the documentation of this file. 
  1. XWBUTL ;OIFO-Oakland/REM - M2M Programmer Utilities ;05/17/2002  17:46
  1.  ;;1.1;RPC BROKER;**28,34**;Mar 28, 1997
  1.  ;
  1.  QUIT
  1.  ;
  1.  ;p34 -correct typo changing ">" to "<" in QUIT:STR'[">" - CHARCHK.
  1.  ;    -add "[]" as escape characters - CHARCHK.
  1.  ;
  1.  ;
  1. XMLHDR() ; -- provides current XML standard header 
  1.  QUIT "<?xml version=""1.0"" encoding=""utf-8"" ?>"
  1.  ;
  1. ERROR(XWBDAT) ; -- send error type message
  1.  NEW XWBI,XWBY
  1.  SET XWBY="XWBY"
  1.  ; -- build xml
  1.  DO BUILD(.XWBY,.XWBDAT)
  1.  ;
  1.  ; -- write xml
  1.  DO PRE^XWBRL
  1.  SET XWBI=0 FOR  SET XWBI=$O(XWBY(XWBI)) Q:'XWBI  DO WRITE^XWBRL(XWBY(XWBI))
  1.  ; -- send eot and flush buffer
  1.  DO POST^XWBRL
  1.  QUIT
  1.  ;
  1. BUILD(XWBY,XWBDAT) ;  -- build xml in passed store reference (XWBY)
  1.  ; -- input format
  1.  ; XWBDAT("MESSAGE TYPE") = type of message (ex. Gov.VA.Med.RPC.Error) 
  1.  ; XWBDAT("ERRORS",<integer>,"CODE") = error code
  1.  ; XWBDAT("ERRORS",<integer>,"ERROR TYPE") = type of error (system/application/security)
  1.  ; XWBDAT("ERRORS",<integer>,"MESSAGE",<integer>) = error message
  1.  ; 
  1.  NEW XWBCODE,XWBI,XWBERR,XWBLINE,XWBETYPE
  1.  SET XWBLINE=0
  1.  ;
  1.  DO ADD($$XMLHDR())
  1.  DO ADD("<vistalink type="""_$G(XWBDAT("MESSAGE TYPE"))_""" >")
  1.  DO ADD("<errors>")
  1.  SET XWBERR=0
  1.  FOR  SET XWBERR=$O(XWBDAT("ERRORS",XWBERR)) Q:'XWBERR  DO
  1.  . SET XWBCODE=$G(XWBDAT("ERRORS",XWBERR,"CODE"),0)
  1.  . SET XWBETYPE=$G(XWBDAT("ERRORS",XWBERR,"ERROR TYPE"),0)
  1.  . DO ADD("<error type="""_XWBETYPE_""" code="""_XWBCODE_""" >")
  1.  . DO ADD("<msg>")
  1.  . IF $G(XWBDAT("ERRORS",XWBERR,"CDATA")) DO ADD("<![CDATA[")
  1.  . SET XWBI=0
  1.  . FOR  SET XWBI=$O(XWBDAT("ERRORS",XWBERR,"MESSAGE",XWBI)) Q:'XWBI  DO
  1.  . . DO ADD(XWBDAT("ERRORS",XWBERR,"MESSAGE",XWBI))
  1.  . IF $G(XWBDAT("ERRORS",XWBERR,"CDATA")) DO ADD("]]>")
  1.  . DO ADD("</msg>")
  1.  . DO ADD("</error>")
  1.  DO ADD("</errors>")
  1.  DO ADD("</vistalink>")
  1.  ;
  1.  QUIT
  1.  ;
  1. ADD(TXT) ; -- add line
  1.  SET XWBLINE=XWBLINE+1
  1.  SET @XWBY@(XWBLINE)=TXT
  1.  QUIT
  1.  ;
  1. CHARCHK(STR) ; -- replace xml character limits with entities
  1.  NEW A,I,X,Y,Z,NEWSTR
  1.  SET (Y,Z)=""
  1.  IF STR["&" SET NEWSTR=STR DO  SET STR=Y_Z
  1.  . FOR X=1:1  SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
  1.  ;
  1.  ;*p34-typo, change ">" to "<" in Q:STR'[... 
  1.  IF STR["<" FOR  SET STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<"
  1.  IF STR[">" FOR  SET STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">"
  1.  IF STR["'" FOR  SET STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'"
  1.  IF STR["""" FOR  SET STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) QUIT:STR'[""""
  1.  ;
  1.  ;*p34-add "[]" as escape characters.
  1.  IF STR["[" FOR  SET STR=$PIECE(STR,"[",1)_"["_$PIECE(STR,"[",2,99) Q:STR'["["
  1.  IF STR["]" FOR  SET STR=$PIECE(STR,"]",1)_"]"_$PIECE(STR,"]",2,99) Q:STR'["]"
  1.  ;
  1.  ;Remove ctrl char's
  1.  S STR=$TR(STR,$C(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
  1.  ;FOR I=1:1:$LENGTH(STR) DO
  1.  ;. SET X=$EXTRACT(STR,I)
  1.  ;. SET A=$ASCII(X)
  1.  ;. IF A<31 S STR=$P(STR,X,1)_$P(STR,X,2,99)
  1.  QUIT STR
  1.  ;
  1.  ;D=0 STR 2 NUM, D=1 NUM 2 STR
  1. NUM(STR,D) ;Convert a string to numbers
  1.  N I,Y
  1.  S Y="",D=$G(D,0)
  1.  I D=0 F I=1:1:$L(STR) S Y=Y_$E(1000+$A(STR,I),2,4)
  1.  I D=1 F I=1:3:$L(STR) S Y=Y_$C($E(STR,I,I+2))
  1.  Q Y