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

XOBWLIB1.m

Go to the documentation of this file. 
  1. XOBWLIB1 ;ALB/MJK - HWSC :: Utilities Library ; 09/13/10 4:00pm
  1.  ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
  1.  ;
  1.  QUIT
  1.  ;
  1.  ;----------------------- Private Calls used By XOBWLIB --------------------------
  1.  WRITE @IOF,!
  1.  WRITE $$CJ^XLFSTR("List of Web Servers",80),!
  1.  WRITE $$CJ^XLFSTR("HealtheVet Web Services Client (HWSC)  "_$$GETBLD(),80),!
  1.  WRITE !,?2,"Name",?31,"Server:Port"
  1.  WRITE !,?2,"====",?31,"==========="
  1.  QUIT
  1.  ;
  1. PAUSE(XOBEXIT) ; -- screen continue message
  1.  NEW X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  WRITE !,?4,"* = enabled"
  1.  SET DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to stop" DO ^DIR KILL DIR
  1.  SET XOBEXIT=+$GET(DIRUT)
  1.  QUIT
  1.  ;
  1. GETBLD() ; -- get current build number
  1.  QUIT "Build "_$$VERSION^XOBWENV()
  1.  ;
  1. STATKSP() ; -- get station number for computing facility
  1.  QUIT $$STA^XUAF4($$KSP^XUPARAM("INST"))
  1.  ;
  1. STATUSER() ; -- get station number for logged-on user
  1.  QUIT $$STA^XUAF4(DUZ(2))
  1.  ;
  1.  ; ----------- web service Proxy APIs ------------
  1.  ; 
  1. ATTACHDR(XOBPROXY) ; -- add VistaInfoHeader to proxy object
  1.  NEW INFOARR
  1.  SET INFOARR=##class(%Library.ArrayOfDataTypes).%New()
  1.  DO INFOARR.SetAt($GET(DUZ,"Unknown"),"duz")
  1.  DO INFOARR.SetAt($$VPID^XUPS($GET(DUZ)),"vpid")
  1.  DO INFOARR.SetAt($IO,"mio")
  1.  DO INFOARR.SetAt($JOB,"mjob")
  1.  DO INFOARR.SetAt($$STATKSP(),"station-ksp")
  1.  DO INFOARR.SetAt($$STATUSER(),"station-user")
  1.  DO INFOARR.SetAt($$PROD^XUPROD(0),"production")
  1.  DO ##class(xobw.VistaInfoHeader).attachHeader(XOBPROXY,INFOARR)
  1.  QUIT
  1.  ; 
  1.  ; ----------- error processing APIs ------------
  1. EOFAC(XOBPROXY) ; --  Error Object FACtory
  1.  NEW $ETRAP,XOBERR
  1.  SET $ETRAP="D ^%ZTER HALT"
  1.  ;
  1.  ; -- SOAP fault error
  1.  IF $$EC^%ZOSV()["<ZSOAP>",$GET(XOBPROXY)]"",XOBPROXY.SoapFault]"" DO  GOTO EOFACQ
  1.  . SET XOBERR=##class(xobw.error.SoapError).%New(XOBPROXY.SoapFault)
  1.  . KILL %objlasterror
  1.  ;
  1.  ; -- object error
  1.  ; -- Future: Can we remove the $$EC^%ZOSV()["<ZSOAP>"? (There could be spurious %objlasterror in partition)
  1.  IF $$EC^%ZOSV()["<ZSOAP>",$GET(%objlasterror)]"" DO  GOTO EOFACQ
  1.  . SET XOBERR=##class(xobw.error.ObjectError).%New(.%objlasterror)
  1.  . KILL %objlasterror
  1.  ;
  1.  ; -- DIALOG object error [used in xobw.WebServiceProxyFactory]
  1.  ;     input structure of %XOBWERR:
  1.  ;       <DIALOG ien> ^ <parameter #1> ^ <parameter #2> ^ <so on...>
  1.  IF $GET(%XOBWERR)]"" DO  GOTO EOFACQ
  1.  . NEW XOBPARMS,XOBCODE,Y,I
  1.  . SET XOBCODE=$PIECE(%XOBWERR,"^")
  1.  . FOR I=2:1 SET Y=$PIECE(%XOBWERR,"^",I) QUIT:Y=""  SET XOBPARMS(I-1)=Y
  1.  . SET XOBERR=##class(xobw.error.DialogError).%New(XOBCODE,$$EZBLD^DIALOG(XOBCODE,.XOBPARMS))
  1.  . KILL %XOBWERR
  1.  ;
  1.  ; -- basic M-type error
  1.  SET XOBERR=##class(xobw.error.BasicError).%New($ECODE,$$EC^%ZOSV())
  1.  ;
  1. EOFACQ ;
  1.  QUIT $GET(XOBERR)
  1.  ;
  1.  ; ----------- Miscellaneous Helper APIs -----------
  1.  ;
  1. IMPORT(XOBDIR,XOBFILE) ; -- import Cache-exported XML file into Cache
  1.  ; input parameters: 
  1.  ;  XOBDIR: directory holding 'export' file
  1.  ;  XOBFILE: 'export' file to import
  1.  ; return: 
  1.  ;  success: positive return value
  1.  ;  failure: 0^reason
  1.  ;  
  1.  NEW XOBPATH,XOBSTAT,XOBLIST,XOBLERR,X,I
  1.  SET XOBPATH=$GET(XOBDIR)_$GET(XOBFILE)
  1.  IF ##class(%File).Exists(XOBPATH) DO
  1.  . SET XOBSTAT=$system.OBJ.Load(XOBPATH,"ck","",.XOBLIST)
  1.  . IF XOBSTAT QUIT
  1.  . DO $system.Status.DecomposeStatus(%objlasterror,.XOBLERR)
  1.  . SET X="" FOR I=1:1:XOBLERR SET X=X_XOBLERR(I)
  1.  . SET XOBSTAT="0^"_X
  1.  ELSE  DO
  1.  . SET XOBSTAT="0^File not found"
  1.  QUIT XOBSTAT
  1.  ;
  1.  ; ----------- web server lookup key APIs -----------
  1.  ; 
  1. SKEYADD(XOBWKEY,XOBWDESC,XOBOERR) ; add or edit a server key name/desc (no prompting)
  1.  NEW XOBFDA,XOBFDAI,XOBIENS,XOBIEN,DIERR,XOBERR
  1.  SET XOBWKEY=$$UP^XLFSTR(XOBWKEY) ; force uppercase
  1.  SET XOBIEN=+$$FIND1^DIC(18.13,"","BX",XOBWKEY,"","","")
  1.  ;
  1.  ; -- If record doesn't already exist, create new
  1.  IF XOBIEN SET XOBIENS=XOBIEN_","
  1.  ELSE  SET XOBIENS="+1,"
  1.  ;
  1.  ; -- Set up array with field values
  1.  SET XOBFDA(18.13,XOBIENS,.01)=$GET(XOBWKEY)
  1.  SET XOBFDA(18.13,XOBIENS,.02)=$GET(XOBWDESC)
  1.  ;
  1.  IF XOBIEN DO  ; edit
  1.  . DO FILE^DIE("E","XOBFDA","XOBERR")
  1.  . IF $DATA(DIERR) DO
  1.  . . SET XOBIEN=0
  1.  . . DO MSG^DIALOG("AE",.XOBOERR,245,"","XOBERR")
  1.  ELSE  DO  ; add
  1.  . DO UPDATE^DIE("E","XOBFDA","XOBFDAI","XOBERR")
  1.  . IF $DATA(DIERR) DO
  1.  . . SET XOBIEN=0
  1.  . . DO MSG^DIALOG("AE",.XOBOERR,245,"","XOBERR")
  1.  . ELSE  DO
  1.  . . SET XOBIEN=$GET(XOBFDAI(1))
  1.  ;
  1.  QUIT $SELECT($GET(XOBIEN)>0:XOBIEN,1:0)
  1.  ;
  1. SNAME4KY(XOBWKEY,XOBWSNM,XOBERR) ; get server name based on key
  1.  NEW XOBWSIEN,XOBKYIEN,XOBKYNM,XOBPARMS
  1.  SET XOBKYNM=$$UP^XLFSTR(XOBWKEY)
  1.  ; -- exist check
  1.  IF XOBKYNM="" SET XOBERR="186008^"_$$EZBLD^DIALOG(186008,"") QUIT 0
  1.  SET XOBKYIEN=$ORDER(^XOB(18.13,"PRIMARY",XOBKYNM,""))
  1.  IF 'XOBKYIEN SET XOBERR="186008^"_$$EZBLD^DIALOG(186008,XOBKYNM) QUIT 0
  1.  ; -- server association check
  1.  SET XOBWSIEN=$PIECE($GET(^XOB(18.13,XOBKYIEN,0)),U,3)
  1.  IF 'XOBWSIEN SET XOBERR="186009^"_$$EZBLD^DIALOG(186009,XOBWKEY) QUIT 0
  1.  ; -- success
  1.  SET XOBWSNM=$PIECE($GET(^XOB(18.12,XOBWSIEN,0)),U)
  1.  QUIT 1
  1.  ;
  1.  ;------------ Developer Testing APIs ------------
  1.  ;
  1. GETSRV() ; -- PUBLIC API: return interactive-user-selected server name
  1.  NEW DIC,DUOUT,DTOUT,X,Y
  1.  SET DIC="^XOB(18.12,"
  1.  SET DIC(0)="AEMQ"
  1.  IF $DATA(^XOB(18.12,+$GET(^DISV(DUZ,"^XOB(18.12,")),0)) SET DIC("B")=$PIECE(^(0),U)
  1.  DO ^DIC KILL DIC
  1.  IF +$GET(Y)'>0 QUIT ""
  1.  QUIT $PIECE(Y,U,2)
  1.  ;
  1. DISPSRVS ; -- display servers
  1.  NEW NAME,IPPORT,DEFAULT,STATUS,SITE,XOBEXIT,XOBI,XOBJ,XOBSVRS,XOBR
  1.  SET XOBEXIT=0,XOBR=""
  1.  SET XOBSVRS=$NAME(XOBDATA("DILIST","ID"))
  1.  DO LIST^DIC(18.12,"",".01;.03;.04;.06","I","","","","","","",$NAME(XOBDATA))
  1.  DO HEAD
  1.  FOR XOBI=0:0 SET XOBI=$ORDER(@XOBSVRS@(XOBI)) QUIT:'XOBI!(XOBEXIT)  DO
  1.  . SET NAME=$GET(@XOBSVRS@(XOBI,.01))
  1.  . SET IPPORT=$GET(@XOBSVRS@(XOBI,.04))_":"_$GET(@XOBSVRS@(XOBI,.03))
  1.  . SET STATUS=$SELECT($GET(@XOBSVRS@(XOBI,.06))=1:"* ",1:" ")
  1.  . IF $Y>(IOSL-5) DO PAUSE(.XOBEXIT) QUIT:XOBEXIT  DO HEAD
  1.  . WRITE !,STATUS,NAME,?31,IPPORT
  1.  IF 'XOBEXIT WRITE !,?0,"* = enabled"
  1.  KILL XOBDATA
  1.  QUIT
  1.  ;