BSTSWSV1.m

BSTSWSV1 ;GDIT/HS/BEE-Standard Terminology Web Service Handling (CONT) ; 5 Nov 2012  9:53 AM

 ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62

 ;

 Q

 ;

SCODE(NMID) ;EP - Get a list of concepts in subsets

 ;

 ;Input

 ; NMID (Optional) - Codeset to run

 ;

 ;Output

 ; Function returns - [1]^[2]^[3]

 ; [1] - 1:Successful remote call

 ;       0:Unsuccessful remote call

 ; [2] - Primary Remote Error Message

 ; [3] - Secondary Remote Error Message (if applicable)

 ;

 N BSTSSRV,PRI,STS,II

 ;

 S NMID=$G(NMID)

 ;

 ;Get list of servers

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,"")

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 S STS="0^No Active Server Found"

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS) I '+STS Q

 . ;

 . ;Call DTS

 . I TYPE="D" D

 .. I NMID=1552 S CSTS=$$RCODE^BSTSDTS5(.BSTSWS) Q

 .. S CSTS=$$SCODE^BSTSDTS4(.BSTSWS)

 . ;

 . ;Log call times (needs completed)

 . S TIME=$P(CSTS,U,3)

 . ;

 . ;Define status variable

 . S $P(STS,U)=+CSTS

 . I II<4 S $P(STS,U,II)=$P(CSTS,U,2)

 ;

 Q STS

 ;

DILKP(OUT,IN,DEBUG) ;EP - Perform a Web Service Drug Ingredient Lookup

 ;

 ;Input

 ; OUT - Output variable/global to return information in (VAR)

 ; IN Array - List of search parameters

 ; DEBUG - 1:DEBUG mode

 ;

 ;Output

 ; Function returns - [1]^[2]^[3]

 ; [1] - 1:Successful remote call

 ;       0:Unsuccessful remote call

 ; [2] - Primary Remote Error Message

 ; [3] - Secondary Remote Error Message (if applicable)

 ;

 ; VAR(#) - [1]^[2]^[3]

 ; [1] - Concept ID

 ; [2] - DTS ID

 ; [3] - Description ID

 ;

 N BSTSSRV,PRI,STS,II

 ;

 ;Define DEBUG

 S DEBUG=$G(DEBUG,"")

 ;

 ;Get list of servers

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 S STS="0^No Active Server Found"

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS) I '+STS Q

 . ;

 . ;Call DTS

 . I TYPE="D" S CSTS=$$DILKP^BSTSDTS1(OUT,.BSTSWS)

 . I $G(BSTSWS("DEBUG")) W !!,"DTS: ",CSTS,!

 . ;

 . ;Log call times (needs completed)

 . S TIME=$P(CSTS,U,3)

 . ;

 . ;Define status variable

 . S $P(STS,U)=+CSTS

 . I II<4 S $P(STS,U,II)=$P(CSTS,U,2)

 ;

 Q STS

 ;

 ;

USEARCH(OUT,IN,DEBUG) ;EP - Perform a Web Service UNIVERSE Search

 ;

 ;Input

 ; OUT - Output variable/global to return information in (VAR)

 ; IN Array - List of search parameters

 ; DEBUG - 1:DEBUG mode

 ;

 ;Output

 ; Function returns - [1]^[2]^[3]

 ; [1] - 1:Successful remote call

 ;       0:Unsuccessful remote call

 ; [2] - Primary Remote Error Message

 ; [3] - Secondary Remote Error Message (if applicable)

 ;

 ; VAR(#) - [1]^[2]^[3]

 ; [1] - Concept ID

 ; [2] - DTS ID

 ; [3] - Description ID

 ;

 N BSTSSRV,PRI,STS,II

 ;

 ;Define DEBUG

 S DEBUG=$G(DEBUG,"")

 ;

 ;Get list of servers

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 S STS="0^No Active Server Found"

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS) I '+STS Q

 . ;

 . ;Call DTS

 . S CSTS=$$USEARCH^BSTSDTS4(OUT,.BSTSWS)

 . I $G(BSTSWS("DEBUG")) W !!,"DTS: ",CSTS,!

 . ;

 . ;Log call times (needs completed)

 . S TIME=$P(CSTS,U,3)

 . ;

 . ;Define status variable

 . S $P(STS,U)=+CSTS

 . I II<4 S $P(STS,U,II)=$P(CSTS,U,2)

 ;

 Q STS

 ;

CKDTS(BSTSWS) ;EP - Determine whether to perform remote call

 ;

 ;Input: BSTSWS Array of Web Service data

 ;

 ;Returns: 1 - Make call to DTS

 ;         0^Server Set to Local - Do not make DTS call

 ;

 NEW BIEN,SWCHLCL,%,VAR,STS,CKPRD,NWCK,BSTS,ERR

 ;

 ;Retrieve definition IEN

 S BIEN=$G(BSTSWS("IEN")) Q:BIEN="" 0

 ;

 ;If CHECK FOR DTS CONNECTION ON is blank allow it

 S SWCHLCL=$$GET1^DIQ(9002318.2,BIEN_",",.13,"I") Q:SWCHLCL="" 1

 ;

 ;Skip for overrides

 I $G(BSTSWS("TBYPASS"))=1 Q 1

 ;

 ;If there is a date/time see if check needs to be performed

 ;If date is in the future stay local

 D NOW^%DTC I SWCHLCL>% Q "0^Server Set To Local"

 ;

 ;Perform a DTS Remote lookup

 S STS=$$VERSIONS^BSTSAPI("VAR")

 ;

 ;If success, clear out CHECK FOR DTS CONNECTION ON

 I +STS=2 D UPDT(BIEN,"@") Q 1

 ;

 ;Update CHECK FOR CONNECTION AFTER value - if blank use 60 minutes in future

 D UPDT(BIEN,$P(STS,U,2))

 ;

 Q "0^Server Set To Local"

 ;

SWLCL(BSTSWS,STS) ;EP - Switch To Local Check

 ;

 ;This call determines whether the DTS server should be switched to local

 ;

 NEW %,NWCK,BSTS,ERR,CKPRD,BIEN,MXSR,CTIME,SUCCESS

 ;

 ;Retrieve definition IEN

 S BIEN=$G(BSTSWS("IEN")) Q:BIEN=""

 ;

 ;Skip for overrides

 I $G(BSTSWS("TBYPASS"))=1 Q

 ;

 ;Check if call succeeded, if not switch to local

 S SUCCESS=$P(STS,U) I SUCCESS=0 D UPDT(BIEN,$S($P(STS,U,2)]"":$P(STS,U,2),1:"DTS call failed")) S $P(STS,U,2)="Switched Server to LOCAL" Q

 ;

 ;Get the call time

 S CTIME=$P(STS,U,3)

 ;

 ;Get the MAXIMUM REMOTE SEARCH TIME

 S MXSR=$$GET1^DIQ(9002318.2,BIEN_",",.15,"I") S:MXSR="" MXSR=60

 ;

 ;If time was too long, switch to local

 I CTIME>MXSR S $P(STS,U,2)="Switched Server to LOCAL" D UPDT(BIEN,"Call was successful but its duration exceeded the MAXIMUM REMOTE SEARCH TIME") Q

 ;

 Q

 ;

UPDT(BIEN,VAL,OVMSG) ;EP - Update the CHECK FOR DTS CONNECTION ON

 ;

 ;Input: BIEN - Pointer to Web Service Entry

 ;        VAL - Error Message - Switch Server to Local

 ;            - @ - Switch Server back on

 ;      OVMSG - Override message on @

 Q:BIEN=""

 I $G(VAL)'="@" D ^ZTER

 S OVMSG=$G(OVMSG)

 ;

 NEW BSTS,ERR,ERRMSG,LOG

 ;

 ;Log entry

 I VAL="@",OVMSG]"" S LOG=OVMSG

 E  I VAL="@",OVMSG="" S LOG="Switched DTS connection on"

 E  S LOG="Switched DTS Connection off: "_VAL

 D ELOG^BSTSVOFL(LOG)

 ;

 ;Get the error message

 S ERRMSG=$S(VAL="":"@",VAL'="@":VAL,1:"@")

 ;

 ;If value equals null, switch to local

 I $G(VAL)'="@" D

 . NEW CKPRD,%

 . ;

 . ;Retrieve CHECK FOR CONNECTION AFTER value - if blank use 60

 . S CKPRD=$$GET1^DIQ(9002318.2,BIEN_",",.14,"I") S:CKPRD="" CKPRD=60

 . ;

 . ;Get current date and time

 . D NOW^%DTC

 . ;

 . S VAL=$$FMADD^XLFDT(%,0,0,CKPRD,0)

 ;

 ;Update CHECK FOR DTS CONNECTION ON

 S BSTS(9002318.2,BIEN_",",.13)=VAL

 S BSTS(9002318.2,BIEN_",",3)=$E(ERRMSG,1,245)

 D FILE^DIE("","BSTS","ERR")

 ;

 Q

 ;

CSTMCDST(OUT,IN) ;EP - Perform a Web Service Custom Codeset Listing

 ;

 ;Input

 ; OUT - Output variable/global to return information in (VAR)

 ; IN Array - List of search parameters

 ; DEBUG - 1:DEBUG mode

 ;

 ;Output

 ; Function returns - [1]^[2]^[3]

 ; [1] - 1:Successful remote call

 ;       0:Unsuccessful remote call

 ; [2] - Primary Remote Error Message

 ; [3] - Secondary Remote Error Message (if applicable)

 ;

 ; VAR(#) - [1]^[2]^[3]

 ; [1] - Concept ID

 ; [2] - DTS ID

 ; [3] - Description ID

 ;

 N BSTSSRV,PRI,STS,II

 ;

 ;Define DEBUG

 S DEBUG=$G(DEBUG,"")

 ;

 ;Get list of servers

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 S STS="0^No Active Server Found"

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS) I '+STS Q

 . ;

 . ;Call DTS

 . S CSTS=$$CSTMCDST^BSTSDTS5(OUT,.BSTSWS)

 . I $G(BSTSWS("DEBUG")) W !!,"DTS: ",CSTS,!

 . ;

 . ;Log call times (needs completed)

 . S TIME=$P(CSTS,U,3)

 . ;

 . ;Define status variable

 . S $P(STS,U)=+CSTS

 . I II<4 S $P(STS,U,II)=$P(CSTS,U,2)

 ;

 Q STS

 ;

ACODE(OUT,IN,DEBUG) ;EP - Perform a Web Service '36' auto-codable ICD10 Listing

 ;

 ;Input

 ; OUT - Output variable/global to return information in (VAR)

 ; IN Array - List of search parameters

 ; DEBUG - 1:DEBUG mode

 ;

 ;Output

 ; Function returns - [1]^[2]^[3]

 ; [1] - 1:Successful remote call

 ;       0:Unsuccessful remote call

 ; [2] - Primary Remote Error Message

 ; [3] - Secondary Remote Error Message (if applicable)

 ;

 ; VAR(#) - [1]^[2]^[3]

 ; [1] - Concept ID

 ; [2] - DTS ID

 ; [3] - Description ID

 ;

 N BSTSSRV,PRI,STS,II

 ;

 ;Define DEBUG

 S DEBUG=$G(DEBUG,"")

 ;

 ;Get list of servers

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 S STS="0^No Active Server Found"

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS) I '+STS Q

 . ;

 . ;Call DTS

 . S CSTS=$$ACODE^BSTSDTS3(OUT,.BSTSWS)

 . I $G(BSTSWS("DEBUG")) W !!,"DTS: ",CSTS,!

 . ;

 . ;Log call times (needs completed)

 . S TIME=$P(CSTS,U,3)

 . ;

 . ;Define status variable

 . S $P(STS,U)=+CSTS

 . I II<4 S $P(STS,U,II)=$P(CSTS,U,2)

 ;

 Q STS

 ;

A9CODE(OUT,IN,DEBUG) ;EP - Perform a Web Service '36' auto-codable ICD9 Listing

 ;

 ;Input

 ; OUT - Output variable/global to return information in (VAR)

 ; IN Array - List of search parameters

 ; DEBUG - 1:DEBUG mode

 ;

 ;Output

 ; Function returns - [1]^[2]^[3]

 ; [1] - 1:Successful remote call

 ;       0:Unsuccessful remote call

 ; [2] - Primary Remote Error Message

 ; [3] - Secondary Remote Error Message (if applicable)

 ;

 ; VAR(#) - [1]^[2]^[3]

 ; [1] - Concept ID

 ; [2] - DTS ID

 ; [3] - Description ID

 ;

 N BSTSSRV,PRI,STS,II

 ;

 ;Define DEBUG

 S DEBUG=$G(DEBUG,"")

 ;

 ;Get list of servers

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 S STS="0^No Active Server Found"

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS) I '+STS Q

 . ;

 . ;Call DTS

 . S CSTS=$$A9CODE^BSTSDTS3(OUT,.BSTSWS)

 . I $G(BSTSWS("DEBUG")) W !!,"DTS: ",CSTS,!

 . ;

 . ;Log call times (needs completed)

 . S TIME=$P(CSTS,U,3)

 . ;

 . ;Define status variable

 . S $P(STS,U)=+CSTS

 . I II<4 S $P(STS,U,II)=$P(CSTS,U,2)

 ;

 Q STS

 ;

 ;BSTS*1.0*4;New tag to reset all links back on

RESET ;EP - Turn all the links back on

 ;

 NEW SITE,SIEN

 ;

 S SITE=0 F  S SITE=$O(^BSTS(9002318,SITE)) Q:'SITE  S SIEN=0 F  S SIEN=$O(^BSTS(9002318,SITE,1,SIEN)) Q:'SIEN  D

 . NEW WIEN,IENS,DA

 . ;

 . ;Get the pointer to the web service entry

 . S DA(1)=SITE,DA=SIEN,IENS=$$IENS^DILF(.DA)

 . S WIEN=$$GET1^DIQ(9002318.01,IENS,".01","I") Q:WIEN=""

 . ;

 . ;Quit if online

 . I $$GET1^DIQ(9002318.2,WIEN_",",".13","I")="" Q

 . ;

 . ;Clear the status

 . D UPDT^BSTSWSV1(WIEN,"@","Reset DTS Link for connection retry")

 Q

 ;

CKONOFF() ;Return when an online server is found

 ;

 NEW STS,BSTSSRV,PRI,II

 ;

 ;Get server list

 S STS=$$WSERVER^BSTSWSV(.BSTSSRV,"")

 ;

 ;Loop through list and make each call

 I $D(BSTSSRV)<10 Q 0

 I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS

 . ;

 . N BSTSWS,TYPE,TIME,CSTS

 . M BSTSWS=IN

 . M BSTSWS=BSTSSRV(PRI)

 . S TYPE=$G(BSTSWS("TYPE")),CSTS=""

 . ;

 . ;Check if DTS server is set to local

 . S STS=$$CKDTS(.BSTSWS)

 ;

 Q STS

BSTSWSV1  ;GDIT/HS/BEE-Standard Terminology Web Service Handling (CONT) ; 5 Nov 2012  9:53 AM

 +1       ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62

 +2       ;

 +3        QUIT 

 +4       ;

SCODE(NMID) ;EP - Get a list of concepts in subsets

 +1       ;

 +2       ;Input

 +3       ; NMID (Optional) - Codeset to run

 +4       ;

 +5       ;Output

 +6       ; Function returns - [1]^[2]^[3]

 +7       ; [1] - 1:Successful remote call

 +8       ;       0:Unsuccessful remote call

 +9       ; [2] - Primary Remote Error Message

 +10      ; [3] - Secondary Remote Error Message (if applicable)

 +11      ;

 +12       NEW BSTSSRV,PRI,STS,II

 +13      ;

 +14       SET NMID=$GET(NMID)

 +15      ;

 +16      ;Get list of servers

 +17       SET STS=$$WSERVER^BSTSWSV(.BSTSSRV,"")

 +18      ;

 +19      ;Loop through list and make each call

 +20       IF $DATA(BSTSSRV)<10

               SET STS="0^No Active Server Found"

 +21       IF $DATA(BSTSSRV)>1

               SET STS=0

               SET PRI=""

               FOR II=2:1

                   SET PRI=$ORDER(BSTSSRV(PRI))

                   IF PRI=""

                       QUIT 

                   Begin DoDot:1

 +22      ;

 +23                   NEW BSTSWS,TYPE,TIME,CSTS

 +24                   MERGE BSTSWS=IN

 +25                   MERGE BSTSWS=BSTSSRV(PRI)

 +26                   SET TYPE=$GET(BSTSWS("TYPE"))

                       SET CSTS=""

 +27      ;

 +28      ;Check if DTS server is set to local

 +29                   SET STS=$$CKDTS(.BSTSWS)

                       IF '+STS

                           QUIT 

 +30      ;

 +31      ;Call DTS

 +32                   IF TYPE="D"

                           Begin DoDot:2

 +33                           IF NMID=1552

                                   SET CSTS=$$RCODE^BSTSDTS5(.BSTSWS)

                                   QUIT 

 +34                           SET CSTS=$$SCODE^BSTSDTS4(.BSTSWS)

                           End DoDot:2

 +35      ;

 +36      ;Log call times (needs completed)

 +37                   SET TIME=$PIECE(CSTS,U,3)

 +38      ;

 +39      ;Define status variable

 +40                   SET $PIECE(STS,U)=+CSTS

 +41                   IF II<4

                           SET $PIECE(STS,U,II)=$PIECE(CSTS,U,2)

                   End DoDot:1

                   IF +STS

                       QUIT 

 +42      ;

 +43       QUIT STS

 +44      ;

DILKP(OUT,IN,DEBUG) ;EP - Perform a Web Service Drug Ingredient Lookup

 +1       ;

 +2       ;Input

 +3       ; OUT - Output variable/global to return information in (VAR)

 +4       ; IN Array - List of search parameters

 +5       ; DEBUG - 1:DEBUG mode

 +6       ;

 +7       ;Output

 +8       ; Function returns - [1]^[2]^[3]

 +9       ; [1] - 1:Successful remote call

 +10      ;       0:Unsuccessful remote call

 +11      ; [2] - Primary Remote Error Message

 +12      ; [3] - Secondary Remote Error Message (if applicable)

 +13      ;

 +14      ; VAR(#) - [1]^[2]^[3]

 +15      ; [1] - Concept ID

 +16      ; [2] - DTS ID

 +17      ; [3] - Description ID

 +18      ;

 +19       NEW BSTSSRV,PRI,STS,II

 +20      ;

 +21      ;Define DEBUG

 +22       SET DEBUG=$GET(DEBUG,"")

 +23      ;

 +24      ;Get list of servers

 +25       SET STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 +26      ;

 +27      ;Loop through list and make each call

 +28       IF $DATA(BSTSSRV)<10

               SET STS="0^No Active Server Found"

 +29       IF $DATA(BSTSSRV)>1

               SET STS=0

               SET PRI=""

               FOR II=2:1

                   SET PRI=$ORDER(BSTSSRV(PRI))

                   IF PRI=""

                       QUIT 

                   Begin DoDot:1

 +30      ;

 +31                   NEW BSTSWS,TYPE,TIME,CSTS

 +32                   MERGE BSTSWS=IN

 +33                   MERGE BSTSWS=BSTSSRV(PRI)

 +34                   SET TYPE=$GET(BSTSWS("TYPE"))

                       SET CSTS=""

 +35      ;

 +36      ;Check if DTS server is set to local

 +37                   SET STS=$$CKDTS(.BSTSWS)

                       IF '+STS

                           QUIT 

 +38      ;

 +39      ;Call DTS

 +40                   IF TYPE="D"

                           SET CSTS=$$DILKP^BSTSDTS1(OUT,.BSTSWS)

 +41                   IF $GET(BSTSWS("DEBUG"))

                           WRITE !!,"DTS: ",CSTS,!

 +42      ;

 +43      ;Log call times (needs completed)

 +44                   SET TIME=$PIECE(CSTS,U,3)

 +45      ;

 +46      ;Define status variable

 +47                   SET $PIECE(STS,U)=+CSTS

 +48                   IF II<4

                           SET $PIECE(STS,U,II)=$PIECE(CSTS,U,2)

                   End DoDot:1

                   IF +STS

                       QUIT 

 +49      ;

 +50       QUIT STS

 +51      ;

 +52      ;

USEARCH(OUT,IN,DEBUG) ;EP - Perform a Web Service UNIVERSE Search

 +1       ;

 +2       ;Input

 +3       ; OUT - Output variable/global to return information in (VAR)

 +4       ; IN Array - List of search parameters

 +5       ; DEBUG - 1:DEBUG mode

 +6       ;

 +7       ;Output

 +8       ; Function returns - [1]^[2]^[3]

 +9       ; [1] - 1:Successful remote call

 +10      ;       0:Unsuccessful remote call

 +11      ; [2] - Primary Remote Error Message

 +12      ; [3] - Secondary Remote Error Message (if applicable)

 +13      ;

 +14      ; VAR(#) - [1]^[2]^[3]

 +15      ; [1] - Concept ID

 +16      ; [2] - DTS ID

 +17      ; [3] - Description ID

 +18      ;

 +19       NEW BSTSSRV,PRI,STS,II

 +20      ;

 +21      ;Define DEBUG

 +22       SET DEBUG=$GET(DEBUG,"")

 +23      ;

 +24      ;Get list of servers

 +25       SET STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 +26      ;

 +27      ;Loop through list and make each call

 +28       IF $DATA(BSTSSRV)<10

               SET STS="0^No Active Server Found"

 +29       IF $DATA(BSTSSRV)>1

               SET STS=0

               SET PRI=""

               FOR II=2:1

                   SET PRI=$ORDER(BSTSSRV(PRI))

                   IF PRI=""

                       QUIT 

                   Begin DoDot:1

 +30      ;

 +31                   NEW BSTSWS,TYPE,TIME,CSTS

 +32                   MERGE BSTSWS=IN

 +33                   MERGE BSTSWS=BSTSSRV(PRI)

 +34                   SET TYPE=$GET(BSTSWS("TYPE"))

                       SET CSTS=""

 +35      ;

 +36      ;Check if DTS server is set to local

 +37                   SET STS=$$CKDTS(.BSTSWS)

                       IF '+STS

                           QUIT 

 +38      ;

 +39      ;Call DTS

 +40                   SET CSTS=$$USEARCH^BSTSDTS4(OUT,.BSTSWS)

 +41                   IF $GET(BSTSWS("DEBUG"))

                           WRITE !!,"DTS: ",CSTS,!

 +42      ;

 +43      ;Log call times (needs completed)

 +44                   SET TIME=$PIECE(CSTS,U,3)

 +45      ;

 +46      ;Define status variable

 +47                   SET $PIECE(STS,U)=+CSTS

 +48                   IF II<4

                           SET $PIECE(STS,U,II)=$PIECE(CSTS,U,2)

                   End DoDot:1

                   IF +STS

                       QUIT 

 +49      ;

 +50       QUIT STS

 +51      ;

CKDTS(BSTSWS) ;EP - Determine whether to perform remote call

 +1       ;

 +2       ;Input: BSTSWS Array of Web Service data

 +3       ;

 +4       ;Returns: 1 - Make call to DTS

 +5       ;         0^Server Set to Local - Do not make DTS call

 +6       ;

 +7        NEW BIEN,SWCHLCL,%,VAR,STS,CKPRD,NWCK,BSTS,ERR

 +8       ;

 +9       ;Retrieve definition IEN

 +10       SET BIEN=$GET(BSTSWS("IEN"))

           IF BIEN=""

               QUIT 0

 +11      ;

 +12      ;If CHECK FOR DTS CONNECTION ON is blank allow it

 +13       SET SWCHLCL=$$GET1^DIQ(9002318.2,BIEN_",",.13,"I")

           IF SWCHLCL=""

               QUIT 1

 +14      ;

 +15      ;Skip for overrides

 +16       IF $GET(BSTSWS("TBYPASS"))=1

               QUIT 1

 +17      ;

 +18      ;If there is a date/time see if check needs to be performed

 +19      ;If date is in the future stay local

 +20       DO NOW^%DTC

           IF SWCHLCL>%

               QUIT "0^Server Set To Local"

 +21      ;

 +22      ;Perform a DTS Remote lookup

 +23       SET STS=$$VERSIONS^BSTSAPI("VAR")

 +24      ;

 +25      ;If success, clear out CHECK FOR DTS CONNECTION ON

 +26       IF +STS=2

               DO UPDT(BIEN,"@")

               QUIT 1

 +27      ;

 +28      ;Update CHECK FOR CONNECTION AFTER value - if blank use 60 minutes in future

 +29       DO UPDT(BIEN,$PIECE(STS,U,2))

 +30      ;

 +31       QUIT "0^Server Set To Local"

 +32      ;

SWLCL(BSTSWS,STS) ;EP - Switch To Local Check

 +1       ;

 +2       ;This call determines whether the DTS server should be switched to local

 +3       ;

 +4        NEW %,NWCK,BSTS,ERR,CKPRD,BIEN,MXSR,CTIME,SUCCESS

 +5       ;

 +6       ;Retrieve definition IEN

 +7        SET BIEN=$GET(BSTSWS("IEN"))

           IF BIEN=""

               QUIT 

 +8       ;

 +9       ;Skip for overrides

 +10       IF $GET(BSTSWS("TBYPASS"))=1

               QUIT 

 +11      ;

 +12      ;Check if call succeeded, if not switch to local

 +13       SET SUCCESS=$PIECE(STS,U)

           IF SUCCESS=0

               DO UPDT(BIEN,$SELECT($PIECE(STS,U,2)]"":$PIECE(STS,U,2),1:"DTS call failed"))

               SET $PIECE(STS,U,2)="Switched Server to LOCAL"

               QUIT 

 +14      ;

 +15      ;Get the call time

 +16       SET CTIME=$PIECE(STS,U,3)

 +17      ;

 +18      ;Get the MAXIMUM REMOTE SEARCH TIME

 +19       SET MXSR=$$GET1^DIQ(9002318.2,BIEN_",",.15,"I")

           IF MXSR=""

               SET MXSR=60

 +20      ;

 +21      ;If time was too long, switch to local

 +22       IF CTIME>MXSR

               SET $PIECE(STS,U,2)="Switched Server to LOCAL"

               DO UPDT(BIEN,"Call was successful but its duration exceeded the MAXIMUM REMOTE SEARCH TIME")

               QUIT 

 +23      ;

 +24       QUIT 

 +25      ;

UPDT(BIEN,VAL,OVMSG) ;EP - Update the CHECK FOR DTS CONNECTION ON

 +1       ;

 +2       ;Input: BIEN - Pointer to Web Service Entry

 +3       ;        VAL - Error Message - Switch Server to Local

 +4       ;            - @ - Switch Server back on

 +5       ;      OVMSG - Override message on @

 +6        IF BIEN=""

               QUIT 

 +7        IF $GET(VAL)'="@"

               DO ^ZTER

 +8        SET OVMSG=$GET(OVMSG)

 +9       ;

 +10       NEW BSTS,ERR,ERRMSG,LOG

 +11      ;

 +12      ;Log entry

 +13       IF VAL="@"

               IF OVMSG]""

                   SET LOG=OVMSG

 +14      IF '$TEST

               IF VAL="@"

                   IF OVMSG=""

                       SET LOG="Switched DTS connection on"

 +15      IF '$TEST

               SET LOG="Switched DTS Connection off: "_VAL

 +16       DO ELOG^BSTSVOFL(LOG)

 +17      ;

 +18      ;Get the error message

 +19       SET ERRMSG=$SELECT(VAL="":"@",VAL'="@":VAL,1:"@")

 +20      ;

 +21      ;If value equals null, switch to local

 +22       IF $GET(VAL)'="@"

               Begin DoDot:1

 +23               NEW CKPRD,%

 +24      ;

 +25      ;Retrieve CHECK FOR CONNECTION AFTER value - if blank use 60

 +26               SET CKPRD=$$GET1^DIQ(9002318.2,BIEN_",",.14,"I")

                   IF CKPRD=""

                       SET CKPRD=60

 +27      ;

 +28      ;Get current date and time

 +29               DO NOW^%DTC

 +30      ;

 +31               SET VAL=$$FMADD^XLFDT(%,0,0,CKPRD,0)

               End DoDot:1

 +32      ;

 +33      ;Update CHECK FOR DTS CONNECTION ON

 +34       SET BSTS(9002318.2,BIEN_",",.13)=VAL

 +35       SET BSTS(9002318.2,BIEN_",",3)=$EXTRACT(ERRMSG,1,245)

 +36       DO FILE^DIE("","BSTS","ERR")

 +37      ;

 +38       QUIT 

 +39      ;

CSTMCDST(OUT,IN) ;EP - Perform a Web Service Custom Codeset Listing

 +1       ;

 +2       ;Input

 +3       ; OUT - Output variable/global to return information in (VAR)

 +4       ; IN Array - List of search parameters

 +5       ; DEBUG - 1:DEBUG mode

 +6       ;

 +7       ;Output

 +8       ; Function returns - [1]^[2]^[3]

 +9       ; [1] - 1:Successful remote call

 +10      ;       0:Unsuccessful remote call

 +11      ; [2] - Primary Remote Error Message

 +12      ; [3] - Secondary Remote Error Message (if applicable)

 +13      ;

 +14      ; VAR(#) - [1]^[2]^[3]

 +15      ; [1] - Concept ID

 +16      ; [2] - DTS ID

 +17      ; [3] - Description ID

 +18      ;

 +19       NEW BSTSSRV,PRI,STS,II

 +20      ;

 +21      ;Define DEBUG

 +22       SET DEBUG=$GET(DEBUG,"")

 +23      ;

 +24      ;Get list of servers

 +25       SET STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)

 +26      ;

 +27      ;Loop through list and make each call

 +28       IF $DATA(BSTSSRV)<10

               SET STS="0^No Active Server Found"

 +29       IF $DATA(BSTSSRV)>1

               SET STS=0

               SET PRI=""

               FOR II=2:1

                   SET PRI=$ORDER(BSTSSRV(PRI))

                   IF PRI=""

                       QUIT 

                   Begin DoDot:1

 +30      ;

 +31                   NEW BSTSWS,TYPE,TIME,CSTS

 +32                   MERGE BSTSWS=IN

 +33                   MERGE BSTSWS=BSTSSRV(PRI)

 +34                   SET TYPE=$GET(BSTSWS("TYPE"))

                       SET CSTS=""

 +35      ;

 +36      ;Check if DTS server is set to local

 +37                   SET STS=$$CKDTS(.BSTSWS)

                       IF '+STS

                           QUIT