XOBWUA1 ;OAK/KEC - HWSC :: Web Server Lookup Key Manager ; 09/13/10 4:00pm
;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
;
QUIT
;
ADD ; -- add web server lookup key entry
NEW DIC,Y,XOBY,D
WRITE !
SET DIC("A")="Enter name for a new web server lookup key: "
SET DIC="^XOB(18.13,",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 WEB SERVER LOOKUP","IDX",$JOB,XOBI,XOBI)))
EDITQ ;
QUIT
;
DOEDIT(DA) ; -- do actual web server lookup key edit
NEW DR,DIE
SET DR="[XOBW WEB SERVER KEY SETUP]",DIE="^XOB(18.13," DO ^DIE
QUIT
;
DEL ; -- delete web server lookup key 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 WEB SERVER LOOKUP","IDX",$JOB,XOBI,XOBI))
DO DISPLAY(XOBI,XOBDA)
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 lookup key delete
NEW DIK
SET DIK="^XOB(18.13," DO ^DIK
QUIT
;
SORT ; -- change sort order
IF XOBSORT="K" DO
. SET XOBSORT="S"
ELSE DO
. SET XOBSORT="K"
QUIT
;
KFILTER ; -- specify lookup key filter
NEW DIR,Y,X,XOBCLR,DTOUT,DUOUT,DIRUT,DIROUT
SET XOBCLR="<clear filter>"
SET DIR(0)="FO^1:30"
SET DIR("A")="Enter lookup key 'starts with' filter text"
IF $GET(XOBKFILT)]"" SET DIR("B")=XOBCLR
DO ^DIR
IF '($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)) DO
. SET XOBKFILT=$SELECT(Y=XOBCLR:"",1:$$UP^XLFSTR(Y))
QUIT
;
SFILTER ; -- specify web server filter
NEW DIR,Y,X,XOBCLR,DTOUT,DUOUT,DIRUT,DIROUT
SET XOBCLR="<clear filter>"
SET DIR(0)="FO^1:30"
SET DIR("A",1)=""
SET DIR("A",2)="Specify web server name 'starts with' filter text."
SET DIR("A",3)="Note: Use <space> to list entries without a web server defined."
SET DIR("A")="Enter filter text"
IF $GET(XOBSFILT)]"" SET DIR("B")=XOBCLR
DO ^DIR
IF '($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)) DO
. SET XOBSFILT=$SELECT(Y=XOBCLR:"",Y=" ":$$NOTDEF^XOBWUA(),1:$$UP^XLFSTR(Y))
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 WEB SERVER LOOKUP","IDX",$JOB,XOBI,XOBI)))
QUIT
;
DISPLAY(XOBI,DA) ; display web server lookup key informaton
; input: XOBI == list entry number
; DA == internal entry number in file 18.12
NEW DIC,XOBLINE,XOBDASH
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.13,"
DO EN^DIQ
WRITE XOBLINE
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBWUA1 3399 printed Dec 13, 2024@02:46:20 Page 2
XOBWUA1 ;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 ;
ADD ; -- add web server lookup key entry
+1 NEW DIC,Y,XOBY,D
+2 WRITE !
+3 SET DIC("A")="Enter name for a new web server lookup key: "
+4 SET DIC="^XOB(18.13,"
SET DIC(0)="AELQ"
SET D="B"
DO IX^DIC
KILL DIC
+5 SET XOBY=Y
+6 IF +XOBY>0
IF '$PIECE(XOBY,U,3)
Begin DoDot:1
+7 DO DISPLAY("",+XOBY)
+8 WRITE !!,"This is not a new entry! Please use 'Edit Server' action."
+9 DO PAUSE^VALM1
End DoDot:1
GOTO ADDQ
+10 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 WEB SERVER LOOKUP","IDX",$JOB,XOBI,XOBI)))
EDITQ ;
+1 QUIT
+2 ;
DOEDIT(DA) ; -- do actual web server lookup key edit
+1 NEW DR,DIE
+2 SET DR="[XOBW WEB SERVER KEY SETUP]"
SET DIE="^XOB(18.13,"
DO ^DIE
+3 QUIT
+4 ;
DEL ; -- delete web server lookup key 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 WEB SERVER LOOKUP","IDX",$JOB,XOBI,XOBI))
+8 DO DISPLAY(XOBI,XOBDA)
+9 Begin DoDot:1
+10 NEW DIR
+11 SET DIR("A")="Are you sure you want to delete entry"
+12 SET DIR("B")="NO"
SET DIR(0)="Y"
+13 WRITE !
+14 DO ^DIR
End DoDot:1
+15 IF '$GET(Y)
Begin DoDot:1
+16 WRITE !!,"Deletion aborted."
+17 DO PAUSE^VALM1
End DoDot:1
GOTO DELQ
+18 ; -- execute deletion
+19 DO DODEL(XOBDA)
+20 WRITE !!,"Entry has been deleted."
+21 DO PAUSE^VALM1
DELQ ;
+1 QUIT
+2 ;
DODEL(DA) ; -- do actual web server lookup key delete
+1 NEW DIK
+2 SET DIK="^XOB(18.13,"
DO ^DIK
+3 QUIT
+4 ;
SORT ; -- change sort order
+1 IF XOBSORT="K"
Begin DoDot:1
+2 SET XOBSORT="S"
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET XOBSORT="K"
End DoDot:1
+5 QUIT
+6 ;
KFILTER ; -- specify lookup key filter
+1 NEW DIR,Y,X,XOBCLR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET XOBCLR="<clear filter>"
+3 SET DIR(0)="FO^1:30"
+4 SET DIR("A")="Enter lookup key 'starts with' filter text"
+5 IF $GET(XOBKFILT)]""
SET DIR("B")=XOBCLR
+6 DO ^DIR
+7 IF '($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
Begin DoDot:1
+8 SET XOBKFILT=$SELECT(Y=XOBCLR:"",1:$$UP^XLFSTR(Y))
End DoDot:1
+9 QUIT
+10 ;
SFILTER ; -- specify web server filter
+1 NEW DIR,Y,X,XOBCLR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET XOBCLR="<clear filter>"
+3 SET DIR(0)="FO^1:30"
+4 SET DIR("A",1)=""
+5 SET DIR("A",2)="Specify web server name 'starts with' filter text."
+6 SET DIR("A",3)="Note: Use <space> to list entries without a web server defined."
+7 SET DIR("A")="Enter filter text"
+8 IF $GET(XOBSFILT)]""
SET DIR("B")=XOBCLR
+9 DO ^DIR
+10 IF '($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
Begin DoDot:1
+11 SET XOBSFILT=$SELECT(Y=XOBCLR:"",Y=" ":$$NOTDEF^XOBWUA(),1:$$UP^XLFSTR(Y))
End DoDot:1
+12 QUIT
+13 ;
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 WEB SERVER LOOKUP","IDX",$JOB,XOBI,XOBI)))
+5 QUIT
+6 ;
DISPLAY(XOBI,DA) ; display web server lookup key informaton
+1 ; input: XOBI == list entry number
+2 ; DA == internal entry number in file 18.12
+3 NEW DIC,XOBLINE,XOBDASH
+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.13,"
+12 DO EN^DIQ
+13 WRITE XOBLINE
+14 QUIT
+15 ;
