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
+38 ;
+39 ;Call DTS
+40 SET CSTS=$$CSTMCDST^BSTSDTS5(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 ;
ACODE(OUT,IN,DEBUG) ;EP - Perform a Web Service '36' auto-codable ICD10 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
+38 ;
+39 ;Call DTS
+40 SET CSTS=$$ACODE^BSTSDTS3(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 ;
A9CODE(OUT,IN,DEBUG) ;EP - Perform a Web Service '36' auto-codable ICD9 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
+38 ;
+39 ;Call DTS
+40 SET CSTS=$$A9CODE^BSTSDTS3(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 ;BSTS*1.0*4;New tag to reset all links back on
RESET ;EP - Turn all the links back on
+1 ;
+2 NEW SITE,SIEN
+3 ;
+4 SET SITE=0
FOR
SET SITE=$ORDER(^BSTS(9002318,SITE))
IF 'SITE
QUIT
SET SIEN=0
FOR
SET SIEN=$ORDER(^BSTS(9002318,SITE,1,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+5 NEW WIEN,IENS,DA
+6 ;
+7 ;Get the pointer to the web service entry
+8 SET DA(1)=SITE
SET DA=SIEN
SET IENS=$$IENS^DILF(.DA)
+9 SET WIEN=$$GET1^DIQ(9002318.01,IENS,".01","I")
IF WIEN=""
QUIT
+10 ;
+11 ;Quit if online
+12 IF $$GET1^DIQ(9002318.2,WIEN_",",".13","I")=""
QUIT
+13 ;
+14 ;Clear the status
+15 DO UPDT^BSTSWSV1(WIEN,"@","Reset DTS Link for connection retry")
End DoDot:1
+16 QUIT
+17 ;
CKONOFF() ;Return when an online server is found
+1 ;
+2 NEW STS,BSTSSRV,PRI,II
+3 ;
+4 ;Get server list
+5 SET STS=$$WSERVER^BSTSWSV(.BSTSSRV,"")
+6 ;
+7 ;Loop through list and make each call
+8 IF $DATA(BSTSSRV)<10
QUIT 0
+9 IF $DATA(BSTSSRV)>1
SET STS=0
SET PRI=""
FOR II=2:1
SET PRI=$ORDER(BSTSSRV(PRI))
IF PRI=""
QUIT
Begin DoDot:1
+10 ;
+11 NEW BSTSWS,TYPE,TIME,CSTS
+12 MERGE BSTSWS=IN
+13 MERGE BSTSWS=BSTSSRV(PRI)
+14 SET TYPE=$GET(BSTSWS("TYPE"))
SET CSTS=""
+15 ;
+16 ;Check if DTS server is set to local
+17 SET STS=$$CKDTS(.BSTSWS)
End DoDot:1
IF +STS
QUIT
+18 ;
+19 QUIT STS
