XOBWU1 ;ALB/MJK - HWSC :: Web Server Manager ; 09/13/10 4:00pm
;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
;
QUIT
;
ADD ; -- add web server entry
NEW DIC,Y,XOBY,D
WRITE !
SET DIC="^XOB(18.12,",DIC(0)="AELQ",D="B" DO IX^DIC KILL DIC
SET XOBY=Y
IF +XOBY>0,'$PIECE(XOBY,U,3) DO GOTO ADDQ
. DO DISPLAY("",+XOBY)
. WRITE !!,"This is not a new entry! Please use 'Edit Server' action."
. DO PAUSE^VALM1
IF +XOBY>0,$PIECE(XOBY,U,3) DO DOEDIT(+XOBY)
ADDQ ;
QUIT
;
EDIT ; -- edit web server entry
NEW DA,DR,DIE,XOBI,VALMY
DO EN^VALM2(XQORNOD(0),"OS")
SET XOBI=+$ORDER(VALMY(""))
IF XOBI>0 DO DOEDIT(+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI)))
EDITQ ;
QUIT
;
DOEDIT(DA) ; -- do actual web server edit
NEW DR,DIE
SET DR="[XOBW WEB SERVER SETUP]",DIE="^XOB(18.12," DO ^DIE
QUIT
;
DEL ; -- delete web server entry
NEW XOBI,VALMY,Y,XOBDA
DO EN^VALM2(XQORNOD(0),"OS")
SET XOBI=+$ORDER(VALMY(""))
; -- quit if nothing selected
IF XOBI'>0 GOTO DELQ
; -- display entry, ask if 'ok' and delete
SET XOBDA=+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI))
DO DISPLAY(XOBI,XOBDA)
IF $ORDER(^XOB(18.13,"WS",XOBDA,""))]"" DO GOTO DELQ
. WRITE !,*7
. WRITE !,"************************************************************"
. WRITE !,"* Lookup keys are still associated with this web server. *"
. WRITE !,"* Deletion prohibited! *"
. WRITE !,"* Use the 'Lookup Key Manager' to change key associations. *"
. WRITE !,"************************************************************"
. DO PAUSE^VALM1
DO
. NEW DIR
. SET DIR("A")="Are you sure you want to delete entry"
. SET DIR("B")="NO",DIR(0)="Y"
. WRITE !
. DO ^DIR
IF '$GET(Y) DO GOTO DELQ
. WRITE !!,"Deletion aborted."
. DO PAUSE^VALM1
; -- execute deletion
DO DODEL(XOBDA)
WRITE !!,"Entry has been deleted."
DO PAUSE^VALM1
DELQ ;
QUIT
;
DODEL(DA) ; -- do actual web server delete
NEW DIK
SET DIK="^XOB(18.12," DO ^DIK
QUIT
;
EXPAND ; -- expand Protocol
NEW DA,DIC,XOBI,VALMY
DO EN^VALM2(XQORNOD(0),"OS")
SET XOBI=+$ORDER(VALMY(""))
IF XOBI>0 DO DISPLAY(XOBI,+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI)))
QUIT
;
DISPLAY(XOBI,DA) ; display web server informaton
; input: XOBI == list entry number
; DA == internal entry number in file 18.12
NEW DIC,XOBLINE,XOBDASH,IEN,IEN0,KEY,XOBY
SET $PIECE(XOBLINE,"=",$GET(IOM,80))=""
SET $PIECE(XOBDASH,"-",$GET(IOM,80))=""
DO CLEAR^VALM1
WRITE !,XOBLINE
IF $GET(XOBI) DO
. WRITE !,@VALMAR@(XOBI,0)
. WRITE !,XOBDASH
SET DIC="^XOB(18.12,"
DO EN^DIQ
WRITE XOBDASH
; -- display lookup keys associated with web server
WRITE !,"Lookup keys associated with server:"
SET IEN=""
FOR SET IEN=$ORDER(^XOB(18.13,"WS",DA,IEN)) QUIT:'IEN DO
. SET IEN0=$GET(^XOB(18.13,IEN,0))
. SET KEY=$PIECE(IEN0,"^")
. IF KEY]"" SET XOBY(KEY)=$PIECE(IEN0,"^",2)
IF $ORDER(XOBY(""))]"" DO
. SET KEY="" FOR SET KEY=$ORDER(XOBY(KEY)) QUIT:KEY="" DO
. . WRITE !?2,"o ",KEY," - ",XOBY(KEY)
ELSE DO
. WRITE !?3,"<No lookup keys associations>"
WRITE !,XOBLINE
QUIT
;
AVAIL ; -- check web service availabilities
NEW XOBI,XOBY,VALMY
DO EN^VALM2(XQORNOD(0),"OS")
SET XOBI=+$ORDER(VALMY(""))
IF $GET(XOBI) DO
. SET XOBY("HEADER",1)="Web Server: "
. SET XOBY("HEADER",2)=@VALMAR@(XOBI,0)
. SET XOBY("TITLE")="Web Service Availability"
. SET XOBY("BUILD CALLBACK")="DO BUILD^XOBWU1("_+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI))_")"
. D EN^XOBWUS2(.XOBY)
QUIT
;
BUILD(XOBDA) ; -- test web services availability
NEW XOBSRVR,XOBY,XOBDOTS,XOBI,XOBX
DO CLEAN^VALM10
SET XOBSRVR=##class(xobw.WebServer).%OpenId(XOBDA)
SET VALMCNT=0
SET XOBDOTS=1 ; -- write dots during check processing
SET XOBY=XOBSRVR.checkWebServicesAvailability(XOBDOTS)
IF XOBY]"",XOBY.Count()>0 DO
. FOR XOBI=1:1:XOBY.Count() SET XOBX=XOBY.GetAt(XOBI) QUIT:XOBI="" DO ADDLN(" "_XOBX)
QUIT
;
ADDLN(XOBTEXT) ; -- add line utility
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,XOBTEXT)
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBWU1 4119 printed Apr 09, 2024@21:48:32 Page 2
XOBWU1 ;ALB/MJK - HWSC :: Web Server Manager ; 09/13/10 4:00pm
+1 ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
+2 ;
+3 QUIT
+4 ;
ADD ; -- add web server entry
+1 NEW DIC,Y,XOBY,D
+2 WRITE !
+3 SET DIC="^XOB(18.12,"
SET DIC(0)="AELQ"
SET D="B"
DO IX^DIC
KILL DIC
+4 SET XOBY=Y
+5 IF +XOBY>0
IF '$PIECE(XOBY,U,3)
Begin DoDot:1
+6 DO DISPLAY("",+XOBY)
+7 WRITE !!,"This is not a new entry! Please use 'Edit Server' action."
+8 DO PAUSE^VALM1
End DoDot:1
GOTO ADDQ
+9 IF +XOBY>0
IF $PIECE(XOBY,U,3)
DO DOEDIT(+XOBY)
ADDQ ;
+1 QUIT
+2 ;
EDIT ; -- edit web server entry
+1 NEW DA,DR,DIE,XOBI,VALMY
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 SET XOBI=+$ORDER(VALMY(""))
+4 IF XOBI>0
DO DOEDIT(+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI)))
EDITQ ;
+1 QUIT
+2 ;
DOEDIT(DA) ; -- do actual web server edit
+1 NEW DR,DIE
+2 SET DR="[XOBW WEB SERVER SETUP]"
SET DIE="^XOB(18.12,"
DO ^DIE
+3 QUIT
+4 ;
DEL ; -- delete web server entry
+1 NEW XOBI,VALMY,Y,XOBDA
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 SET XOBI=+$ORDER(VALMY(""))
+4 ; -- quit if nothing selected
+5 IF XOBI'>0
GOTO DELQ
+6 ; -- display entry, ask if 'ok' and delete
+7 SET XOBDA=+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI))
+8 DO DISPLAY(XOBI,XOBDA)
+9 IF $ORDER(^XOB(18.13,"WS",XOBDA,""))]""
Begin DoDot:1
+10 WRITE !,*7
+11 WRITE !,"************************************************************"
+12 WRITE !,"* Lookup keys are still associated with this web server. *"
+13 WRITE !,"* Deletion prohibited! *"
+14 WRITE !,"* Use the 'Lookup Key Manager' to change key associations. *"
+15 WRITE !,"************************************************************"
+16 DO PAUSE^VALM1
End DoDot:1
GOTO DELQ
+17 Begin DoDot:1
+18 NEW DIR
+19 SET DIR("A")="Are you sure you want to delete entry"
+20 SET DIR("B")="NO"
SET DIR(0)="Y"
+21 WRITE !
+22 DO ^DIR
End DoDot:1
+23 IF '$GET(Y)
Begin DoDot:1
+24 WRITE !!,"Deletion aborted."
+25 DO PAUSE^VALM1
End DoDot:1
GOTO DELQ
+26 ; -- execute deletion
+27 DO DODEL(XOBDA)
+28 WRITE !!,"Entry has been deleted."
+29 DO PAUSE^VALM1
DELQ ;
+1 QUIT
+2 ;
DODEL(DA) ; -- do actual web server delete
+1 NEW DIK
+2 SET DIK="^XOB(18.12,"
DO ^DIK
+3 QUIT
+4 ;
EXPAND ; -- expand Protocol
+1 NEW DA,DIC,XOBI,VALMY
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 SET XOBI=+$ORDER(VALMY(""))
+4 IF XOBI>0
DO DISPLAY(XOBI,+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI)))
+5 QUIT
+6 ;
DISPLAY(XOBI,DA) ; display web server informaton
+1 ; input: XOBI == list entry number
+2 ; DA == internal entry number in file 18.12
+3 NEW DIC,XOBLINE,XOBDASH,IEN,IEN0,KEY,XOBY
+4 SET $PIECE(XOBLINE,"=",$GET(IOM,80))=""
+5 SET $PIECE(XOBDASH,"-",$GET(IOM,80))=""
+6 DO CLEAR^VALM1
+7 WRITE !,XOBLINE
+8 IF $GET(XOBI)
Begin DoDot:1
+9 WRITE !,@VALMAR@(XOBI,0)
+10 WRITE !,XOBDASH
End DoDot:1
+11 SET DIC="^XOB(18.12,"
+12 DO EN^DIQ
+13 WRITE XOBDASH
+14 ; -- display lookup keys associated with web server
+15 WRITE !,"Lookup keys associated with server:"
+16 SET IEN=""
+17 FOR
SET IEN=$ORDER(^XOB(18.13,"WS",DA,IEN))
if 'IEN
QUIT
Begin DoDot:1
+18 SET IEN0=$GET(^XOB(18.13,IEN,0))
+19 SET KEY=$PIECE(IEN0,"^")
+20 IF KEY]""
SET XOBY(KEY)=$PIECE(IEN0,"^",2)
End DoDot:1
+21 IF $ORDER(XOBY(""))]""
Begin DoDot:1
+22 SET KEY=""
FOR
SET KEY=$ORDER(XOBY(KEY))
if KEY=""
QUIT
Begin DoDot:2
+23 WRITE !?2,"o ",KEY," - ",XOBY(KEY)
End DoDot:2
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 WRITE !?3,"<No lookup keys associations>"
End DoDot:1
+26 WRITE !,XOBLINE
+27 QUIT
+28 ;
AVAIL ; -- check web service availabilities
+1 NEW XOBI,XOBY,VALMY
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 SET XOBI=+$ORDER(VALMY(""))
+4 IF $GET(XOBI)
Begin DoDot:1
+5 SET XOBY("HEADER",1)="Web Server: "
+6 SET XOBY("HEADER",2)=@VALMAR@(XOBI,0)
+7 SET XOBY("TITLE")="Web Service Availability"
+8 SET XOBY("BUILD CALLBACK")="DO BUILD^XOBWU1("_+$GET(^TMP("XOB WEBSERVERS","IDX",$JOB,XOBI,XOBI))_")"
+9 DO EN^XOBWUS2(.XOBY)
End DoDot:1
+10 QUIT
+11 ;
BUILD(XOBDA) ; -- test web services availability
+1 NEW XOBSRVR,XOBY,XOBDOTS,XOBI,XOBX
+2 DO CLEAN^VALM10
+3 SET XOBSRVR=##class(xobw.WebServer).%OpenId(XOBDA)
+4 SET VALMCNT=0
+5 ; -- write dots during check processing
SET XOBDOTS=1
+6 SET XOBY=XOBSRVR.checkWebServicesAvailability(XOBDOTS)
+7 IF XOBY]""
IF XOBY.Count()>0
Begin DoDot:1
+8 FOR XOBI=1:1:XOBY.Count()
SET XOBX=XOBY.GetAt(XOBI)
if XOBI=""
QUIT
DO ADDLN(" "_XOBX)
End DoDot:1
+9 QUIT
+10 ;
ADDLN(XOBTEXT) ; -- add line utility
+1 SET VALMCNT=VALMCNT+1
+2 DO SET^VALM10(VALMCNT,XOBTEXT)
+3 QUIT
+4 ;
