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