XOBWUA1.m

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 ---XOBWUA1   3399     printed  Mar 13, 2025@21:51:22                                                                                                                                                                                                     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      ;