XOBWUA ;OAK/KEC - HWSC :: Web Server Lookup Key Manager ; 09/13/10 4:00pm
;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
;
QUIT
;
EN ; -- main entry point for XOBW WEB SERVER LOOKUPKEY
NEW XOBSORT,XOBKFILT,XOBSFILT,X
SET XOBSORT="K" ; default sort by KEY
SET XOBKFILT=""
SET XOBSFILT=""
DO KILL
SET VALMBCK=""
DO EN^VALM("XOBW WEB SERVER LOOKUPKEY")
QUIT
;
HDR ; -- header code
SET X=" HWSC Web Server Lookup Key Manager"
SET VALMHDR(1)=X
SET X=" Version: "_$PIECE($TEXT(XOBWUA+1),";",3)_" Build: "_$$VERSION^XOBWENV()
SET VALMHDR(2)=X
SET X=$SELECT(XOBSFILT]"":XOBSFILT,1:"<no filter>")
SET VALMHDR(3)="Filters: Key = "_$SELECT(XOBKFILT]"":XOBKFILT,1:"<no filter>")_" Server = "_X
QUIT
;
CHGCAP ; -- change captions to indicate sort
NEW KEYCAP,SRVCAP
SET KEYCAP="Lookup Key Name"
SET SRVCAP="Web Server Name"
IF XOBSORT="K" DO
. DO CHGCAP^VALM("KEY",KEYCAP_" [Sorted By]")
. DO CHGCAP^VALM("SERVER",SRVCAP)
ELSE DO
. DO CHGCAP^VALM("SERVER",SRVCAP_" [Sorted By]")
. DO CHGCAP^VALM("KEY",KEYCAP)
QUIT
;
INIT ; -- init variables and list array
DO CLEAR
DO MSG
DO CHGCAP
QUIT
;
MSG ; -- set default message
SET VALMSG=""
QUIT
;
BUILD ; -- build list
NEW I,XOBI,XOB0,X,XOBDATA,XOBROOT,XOBSITEI,Y,SORT,XOBX,XOBKEY,XOBSRVR
DO KILL
;
SET VALMCNT=0
SET XOBROOT=$NAME(XOBDATA("DILIST","ID"))
DO LIST^DIC(18.13,"",".01;.03","","","","","","","",$NAME(XOBDATA))
; -- build sort
SET XOBI=0
FOR SET XOBI=$ORDER(@XOBROOT@(XOBI)) QUIT:'XOBI DO
. SET XOBX=$SELECT(XOBSORT="S":$GET(@XOBROOT@(XOBI,.03)),1:$GET(@XOBROOT@(XOBI,.01)))
. SET SORT($SELECT(XOBX="":" ",1:XOBX),XOBI)=""
; -- build list off sort and apply filters
SET XOBX=""
FOR SET XOBX=$ORDER(SORT(XOBX)) QUIT:XOBX="" DO
. SET XOBI=0
. FOR SET XOBI=$ORDER(SORT(XOBX,XOBI)) QUIT:'XOBI DO
. . SET XOBKEY=$GET(@XOBROOT@(XOBI,.01))
. . SET XOBSRVR=$GET(@XOBROOT@(XOBI,.03))
. . IF XOBSRVR="" SET XOBSRVR=$$NOTDEF()
. . IF XOBKFILT]"",$EXTRACT(XOBKEY,1,$LENGTH(XOBKFILT))'=XOBKFILT QUIT
. . IF XOBSFILT]"",$$UP^XLFSTR($EXTRACT(XOBSRVR,1,$LENGTH(XOBSFILT)))'=$$UP^XLFSTR(XOBSFILT) QUIT
. . SET VALMCNT=VALMCNT+1
. . SET X=""
. . SET X=$$SETFLD^VALM1(VALMCNT,X,"ID")
. . SET X=$$SETFLD^VALM1(XOBKEY,X,"KEY")
. . SET X=$$SETFLD^VALM1(XOBSRVR,X,"SERVER")
. . DO SET^VALM10(VALMCNT,X,VALMCNT)
. . SET ^TMP("XOB WEB SERVER LOOKUP","IDX",$JOB,VALMCNT,VALMCNT)=+$GET(XOBDATA("DILIST",2,XOBI))
;
QUIT
;
NOTDEF() ; -- constant text to use if server is not defined
QUIT "<server not defined>"
;
CLEAR ; -- clean up entries
DO REFRESH
QUIT
;
REFRESH ; -- refresh display
DO BUILD
SET VALMBCK="R"
QUIT
;
KILL ; -- kill off list location
KILL ^TMP("XOB WEB SERVER LOOKUP",$JOB)
KILL ^TMP("XOB WEB SERVER LOOKUP","XOB",$JOB)
QUIT
;
HELP ; -- help code
SET X="?" DO DISP^XQORM1 WRITE !!
QUIT
;
EXIT ; -- exit code
QUIT
;
ADD ; -- add a web server lookup identifier entry
; -- Protocol: XOBW ASSOCIATE ADD
DO ACTION("ADD",0)
QUIT
;
EDIT ; -- edit a web server lookup identifier entry
; -- Protocol: XOBW ASSOCIATE EDIT
DO ACTION("EDIT",0)
QUIT
;
DEL ; -- delete web server lookup identifier entry
; -- Protocol: XOBW ASSOCIATE DELETE
DO ACTION("DEL",0)
QUIT
;
EXPAND ; -- expand web server lookup identifier entry
DO ACTION("EXPAND",1)
QUIT
;
SORT ; -- sort list
; -- Protocol: XOBW ASSOCIATE SORT
DO ACTION("SORT",0)
DO HDR
DO CHGCAP
QUIT
;
KFILTER ; -- specify look up key filter
; -- Protocol: XOBW ASSOCIATE FILTER KEY
DO ACTION("KFILTER",0)
DO HDR
QUIT
;
SFILTER ; -- specify web server filter
; -- Protocol: XOBW ASSOCIATE FILTER SERVER
DO ACTION("SFILTER",0)
DO HDR
QUIT
;
ACTION(TYPE,XOBPAUSE) ; -- execute action
DO FULL^VALM1
NEW X,Y
SET X="DO "_TYPE_"^XOBWUA1"
XECUTE X
IF XOBPAUSE DO PAUSE^VALM1
DO REFRESH
DO MSG
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBWUA 3997 printed Dec 13, 2024@02:46:20 Page 2
XOBWUA ;OAK/KEC - HWSC :: Web Server Lookup Key Manager ; 09/13/10 4:00pm
+1 ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
+2 ;
+3 QUIT
+4 ;
EN ; -- main entry point for XOBW WEB SERVER LOOKUPKEY
+1 NEW XOBSORT,XOBKFILT,XOBSFILT,X
+2 ; default sort by KEY
SET XOBSORT="K"
+3 SET XOBKFILT=""
+4 SET XOBSFILT=""
+5 DO KILL
+6 SET VALMBCK=""
+7 DO EN^VALM("XOBW WEB SERVER LOOKUPKEY")
+8 QUIT
+9 ;
HDR ; -- header code
+1 SET X=" HWSC Web Server Lookup Key Manager"
+2 SET VALMHDR(1)=X
+3 SET X=" Version: "_$PIECE($TEXT(XOBWUA+1),";",3)_" Build: "_$$VERSION^XOBWENV()
+4 SET VALMHDR(2)=X
+5 SET X=$SELECT(XOBSFILT]"":XOBSFILT,1:"<no filter>")
+6 SET VALMHDR(3)="Filters: Key = "_$SELECT(XOBKFILT]"":XOBKFILT,1:"<no filter>")_" Server = "_X
+7 QUIT
+8 ;
CHGCAP ; -- change captions to indicate sort
+1 NEW KEYCAP,SRVCAP
+2 SET KEYCAP="Lookup Key Name"
+3 SET SRVCAP="Web Server Name"
+4 IF XOBSORT="K"
Begin DoDot:1
+5 DO CHGCAP^VALM("KEY",KEYCAP_" [Sorted By]")
+6 DO CHGCAP^VALM("SERVER",SRVCAP)
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO CHGCAP^VALM("SERVER",SRVCAP_" [Sorted By]")
+9 DO CHGCAP^VALM("KEY",KEYCAP)
End DoDot:1
+10 QUIT
+11 ;
INIT ; -- init variables and list array
+1 DO CLEAR
+2 DO MSG
+3 DO CHGCAP
+4 QUIT
+5 ;
MSG ; -- set default message
+1 SET VALMSG=""
+2 QUIT
+3 ;
BUILD ; -- build list
+1 NEW I,XOBI,XOB0,X,XOBDATA,XOBROOT,XOBSITEI,Y,SORT,XOBX,XOBKEY,XOBSRVR
+2 DO KILL
+3 ;
+4 SET VALMCNT=0
+5 SET XOBROOT=$NAME(XOBDATA("DILIST","ID"))
+6 DO LIST^DIC(18.13,"",".01;.03","","","","","","","",$NAME(XOBDATA))
+7 ; -- build sort
+8 SET XOBI=0
+9 FOR
SET XOBI=$ORDER(@XOBROOT@(XOBI))
if 'XOBI
QUIT
Begin DoDot:1
+10 SET XOBX=$SELECT(XOBSORT="S":$GET(@XOBROOT@(XOBI,.03)),1:$GET(@XOBROOT@(XOBI,.01)))
+11 SET SORT($SELECT(XOBX="":" ",1:XOBX),XOBI)=""
End DoDot:1
+12 ; -- build list off sort and apply filters
+13 SET XOBX=""
+14 FOR
SET XOBX=$ORDER(SORT(XOBX))
if XOBX=""
QUIT
Begin DoDot:1
+15 SET XOBI=0
+16 FOR
SET XOBI=$ORDER(SORT(XOBX,XOBI))
if 'XOBI
QUIT
Begin DoDot:2
+17 SET XOBKEY=$GET(@XOBROOT@(XOBI,.01))
+18 SET XOBSRVR=$GET(@XOBROOT@(XOBI,.03))
+19 IF XOBSRVR=""
SET XOBSRVR=$$NOTDEF()
+20 IF XOBKFILT]""
IF $EXTRACT(XOBKEY,1,$LENGTH(XOBKFILT))'=XOBKFILT
QUIT
+21 IF XOBSFILT]""
IF $$UP^XLFSTR($EXTRACT(XOBSRVR,1,$LENGTH(XOBSFILT)))'=$$UP^XLFSTR(XOBSFILT)
QUIT
+22 SET VALMCNT=VALMCNT+1
+23 SET X=""
+24 SET X=$$SETFLD^VALM1(VALMCNT,X,"ID")
+25 SET X=$$SETFLD^VALM1(XOBKEY,X,"KEY")
+26 SET X=$$SETFLD^VALM1(XOBSRVR,X,"SERVER")
+27 DO SET^VALM10(VALMCNT,X,VALMCNT)
+28 SET ^TMP("XOB WEB SERVER LOOKUP","IDX",$JOB,VALMCNT,VALMCNT)=+$GET(XOBDATA("DILIST",2,XOBI))
End DoDot:2
End DoDot:1
+29 ;
+30 QUIT
+31 ;
NOTDEF() ; -- constant text to use if server is not defined
+1 QUIT "<server not defined>"
+2 ;
CLEAR ; -- clean up entries
+1 DO REFRESH
+2 QUIT
+3 ;
REFRESH ; -- refresh display
+1 DO BUILD
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
KILL ; -- kill off list location
+1 KILL ^TMP("XOB WEB SERVER LOOKUP",$JOB)
+2 KILL ^TMP("XOB WEB SERVER LOOKUP","XOB",$JOB)
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
ADD ; -- add a web server lookup identifier entry
+1 ; -- Protocol: XOBW ASSOCIATE ADD
+2 DO ACTION("ADD",0)
+3 QUIT
+4 ;
EDIT ; -- edit a web server lookup identifier entry
+1 ; -- Protocol: XOBW ASSOCIATE EDIT
+2 DO ACTION("EDIT",0)
+3 QUIT
+4 ;
DEL ; -- delete web server lookup identifier entry
+1 ; -- Protocol: XOBW ASSOCIATE DELETE
+2 DO ACTION("DEL",0)
+3 QUIT
+4 ;
EXPAND ; -- expand web server lookup identifier entry
+1 DO ACTION("EXPAND",1)
+2 QUIT
+3 ;
SORT ; -- sort list
+1 ; -- Protocol: XOBW ASSOCIATE SORT
+2 DO ACTION("SORT",0)
+3 DO HDR
+4 DO CHGCAP
+5 QUIT
+6 ;
KFILTER ; -- specify look up key filter
+1 ; -- Protocol: XOBW ASSOCIATE FILTER KEY
+2 DO ACTION("KFILTER",0)
+3 DO HDR
+4 QUIT
+5 ;
SFILTER ; -- specify web server filter
+1 ; -- Protocol: XOBW ASSOCIATE FILTER SERVER
+2 DO ACTION("SFILTER",0)
+3 DO HDR
+4 QUIT
+5 ;
ACTION(TYPE,XOBPAUSE) ; -- execute action
+1 DO FULL^VALM1
+2 NEW X,Y
+3 SET X="DO "_TYPE_"^XOBWUA1"
+4 XECUTE X
+5 IF XOBPAUSE
DO PAUSE^VALM1
+6 DO REFRESH
+7 DO MSG
+8 QUIT
+9 ;
