ORRDI2 ; SLC/JMH - RDI routine for user interface and data cleanup; 3/24/05 2:31 ;02/08/12 08:36
;;3.0;ORDER ENTRY/RESULTS REPORTING;**232,294,345**;Dec 17, 1997;Build 32
;
SET ;utility to set RDI related parameters
I '$$PATCH^XPDUTL("OR*3.0*238") D Q
. W !,"This menu is locked until patch OR*3.0*238 is installed."
N QUIT,QUITALL
W !!,"Sets System wide parameters to control order checking against"
W !," remote data",!
F Q:$G(QUIT)!($G(QUITALL)) D
. N VAL,VALEXT,DIR,DTOUT,Y
. S VAL=$$GET^XPAR("SYS","OR RDI HAVE HDR")
. S VALEXT="NO" I VAL=1 S VALEXT="YES"
. S DIR("A")="HAVE AN HDR"
. S DIR("B")=VALEXT
. S DIR("?")="^D HELP1^ORRDI2"
. S DIR(0)="Y"
. D ^DIR
. I $G(Y)="^"!($G(DTOUT)) S QUITALL=1
. I $G(Y)=1!($G(Y)=0) S QUIT=1 D
. . D EN^XPAR("SYS","OR RDI HAVE HDR",,Y)
I $G(QUITALL) Q
I '$$GET^XPAR("SYS","OR RDI HAVE HDR") Q
S QUIT=0
F Q:$G(QUIT)!($G(QUITALL)) D
. N VAL,VALEXT,DIR,DTOUT,Y
. S VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
. S VALEXT=$G(VAL,0)
. S DIR("A")="CACHE TIME (Minutes)"
. S DIR("B")=VALEXT
. S DIR("?")="^D HELP3^ORRDI2"
. S DIR(0)="N^0:9999:0"
. D ^DIR
. I $G(Y)="^"!($G(DTOUT)) S QUITALL=1
. I $G(Y)>-1 S QUIT=1 D
. . D EN^XPAR("SYS","OR RDI CACHE TIME",,Y)
Q
HELP1 ;
W "Set this to ""YES"" if this system has an HDR system that"
W !," it uses to access remote data."
Q
HELP3 ;
W "Set this to the number of minutes that the retrieved data is "
W !," to be considered valid for order checking purposes."
Q
LIST ;
W !
W $$GET^XPAR("SYS","OR RDI HAVE HDR")," "
W $$GET^XPAR("SYS","OR RDI CACHE TIME")
Q
CLEANUP ;
N VAL,NOW,THRESH,DOM,DFN,TIME
S VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
S NOW=$$NOW^XLFDT
S THRESH=$$FMADD^XLFDT(NOW,,,-VAL)
S DFN=0
F DOM="PSOO","ART" F S DFN=$O(^XTMP("ORRDI",DOM,DFN)) Q:'DFN D
. S TIME=$G(^XTMP("ORRDI",DOM,DFN,0))
. I TIME<THRESH K ^XTMP("ORRDI",DOM,DFN)
;clear out metrics data older than 5 days
N ORDT,ORDIFF S ORDT=0
F S ORDT=$O(^XTMP("ORRDI","METRICS",ORDT)) Q:'ORDT S ORDIFF=$$FMDIFF^XLFDT($$NOW^XLFDT,ORDT,1) Q:ORDIFF<5 K ^XTMP("ORRDI","METRICS",ORDT)
; checking if OUTAGE task crashed or hasn't completed successfully
I $$DOWNXVAL D
.I $$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)>($$PINGPVAL*2) D SPAWN^ORRDI2
Q
DOWNRPC(ORY) ;can be used in an RPC to check if RDI is in an OUTAGE state (HDR DOWN)
S ORY=$$DOWNXVAL
Q
DICNPVAL() ;parameter value for dummy patient ICN
Q $$GET^XPAR("ALL","ORRDI DUMMY ICN")
FAILPVAL() ;parameter value for failure threshold
Q $$GET^XPAR("ALL","ORRDI FAIL THRESH")
SUCCPVAL() ;parameter value for success threshold
Q $$GET^XPAR("ALL","ORRDI SUCCEED THRESH")
PINGPVAL() ;parameter value for ping frequency
Q $$GET^XPAR("ALL","ORRDI PING FREQ")
DOWNXVAL() ;xtmp value for OUTAGE state
Q $G(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
FAILXVAL() ;xtmp value for number of failed reads
Q $G(^XTMP("ORRDI","OUTAGE INFO","FAILURES"))
SUCCXVAL() ;xtmp value for number of successful reads
Q $G(^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS"))
PINGXVAL() ;xtmp value for last ping time
Q $G(^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING"))
LDPTTVAL(DFN) ;tmp value for if the local data only message has been shown to the user during ordering session
Q $G(^TMP($J,"ORRDI",DFN))
SPAWN ;subroutine to spawn the DOWNTSK task
K ^XTMP("ORRDI","ART"),^XTMP("ORRDI","PSOO")
N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDTH
S ZTDESC="RDI TASK TO CHECK IF HDR IS UP"
S ZTRTN="DOWNTSK^ORRDI2"
S ZTIO="NULL"
S ZTDTH=$$NOW^XLFDT+.000001
D ^%ZTLOAD
Q
DOWNTSK ;subroutine to check if HDR is back up
N ORLE S ORLE=0
S ^XTMP("ORRDI","OUTAGE LOG",$$NOW^XLFDT)="GOING DOWN"
F Q:(($$SUCCXVAL'<$$SUCCPVAL)!('$$DOWNXVAL)) D
.N WAIT,RSLT
.S WAIT=$$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)
.S WAIT=$$PINGPVAL-WAIT
.;wait until the proper # of seconds has expired before retrying
.I WAIT>0 H WAIT
.S ^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING")=$$NOW^XLFDT
.;send dummy message
.S RSLT=$$TESTCALL
.;if successful increment success counter
.I RSLT=1 S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=1+$$SUCCXVAL
.;if failure set success counter to 0
.I RSLT'=1 S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=0
K ^XTMP("ORRDI","OUTAGE INFO")
S ^XTMP("ORRDI","OUTAGE LOG",$$NOW^XLFDT)="BACK UP"
Q
TCOLD() ;call to send a test call to CDS...returns 1 if successful, 0 OR -9 if not
N ORREQ,ORXML,ORRET,XML,ORERR
S ORREQ="/isAlive"
S ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
S ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,1)
I 'ORRET Q 0
While (ORXML.HttpResponse.Data.AtEnd = 0) {S XML=ORXML.HttpResponse.Data.Read(100)}
Q:XML="true" 1
Q 0
TESTCALL() ;call to send a test call to CDS...returns 1 if successful, 0 or -9 if not
N ORREQ,ORXML,ORRET,ORERR ;;CHANGE add ORERR to NEW list
N $ETRAP,$ESTACK SET $ETRAP="DO ERRH^ORRDI2" ;;CHANGE set error trap
I $L($G(^XTMP("ORRDI","TESTREQ")))'>0 Q $$TCOLD() ;USES isAlive IF NO TEST REQUEST IS PRESENT
S ORREQ=$G(^XTMP("ORRDI","TESTREQ"))
S ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
S ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,1) ;;CHANGE change force error to 1
I 'ORRET Q 0
K ^TMP($J,"ORRDI")
D PARSE^ORRDI1(ORXML.HttpResponse.Data)
I $L($$MSGERR^ORRDI1)>0 K ^TMP($J,"ORRDI") Q 0
K ^TMP($J,"ORRDI")
Q 1
ERRH ; error handler for TESTCALL/TCOLD
SET:'$DATA(ORERR) ORERR=$$EOFAC^XOBWLIB() ; create error object if needed
IF '+$GET(ZTSK) DO ERRDISP^XOBWLIB(.ORERR) W !! ;non-task: interactive error display
;ELSE I $G(ORLE)#15=0 DO ZTER^XOBWLIB(ORERR) ; tasked: expand into XOBEOARR, store in error log
S ORLE=$G(ORLE)+1
DO UNWIND^%ZTER ; throw to MenuMan, TaskMan or next higher error handler
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRDI2 5769 printed Apr 09, 2024@21:31:21 Page 2
ORRDI2 ; SLC/JMH - RDI routine for user interface and data cleanup; 3/24/05 2:31 ;02/08/12 08:36
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232,294,345**;Dec 17, 1997;Build 32
+2 ;
SET ;utility to set RDI related parameters
+1 IF '$$PATCH^XPDUTL("OR*3.0*238")
Begin DoDot:1
+2 WRITE !,"This menu is locked until patch OR*3.0*238 is installed."
End DoDot:1
QUIT
+3 NEW QUIT,QUITALL
+4 WRITE !!,"Sets System wide parameters to control order checking against"
+5 WRITE !," remote data",!
+6 FOR
if $GET(QUIT)!($GET(QUITALL))
QUIT
Begin DoDot:1
+7 NEW VAL,VALEXT,DIR,DTOUT,Y
+8 SET VAL=$$GET^XPAR("SYS","OR RDI HAVE HDR")
+9 SET VALEXT="NO"
IF VAL=1
SET VALEXT="YES"
+10 SET DIR("A")="HAVE AN HDR"
+11 SET DIR("B")=VALEXT
+12 SET DIR("?")="^D HELP1^ORRDI2"
+13 SET DIR(0)="Y"
+14 DO ^DIR
+15 IF $GET(Y)="^"!($GET(DTOUT))
SET QUITALL=1
+16 IF $GET(Y)=1!($GET(Y)=0)
SET QUIT=1
Begin DoDot:2
+17 DO EN^XPAR("SYS","OR RDI HAVE HDR",,Y)
End DoDot:2
End DoDot:1
+18 IF $GET(QUITALL)
QUIT
+19 IF '$$GET^XPAR("SYS","OR RDI HAVE HDR")
QUIT
+20 SET QUIT=0
+21 FOR
if $GET(QUIT)!($GET(QUITALL))
QUIT
Begin DoDot:1
+22 NEW VAL,VALEXT,DIR,DTOUT,Y
+23 SET VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
+24 SET VALEXT=$GET(VAL,0)
+25 SET DIR("A")="CACHE TIME (Minutes)"
+26 SET DIR("B")=VALEXT
+27 SET DIR("?")="^D HELP3^ORRDI2"
+28 SET DIR(0)="N^0:9999:0"
+29 DO ^DIR
+30 IF $GET(Y)="^"!($GET(DTOUT))
SET QUITALL=1
+31 IF $GET(Y)>-1
SET QUIT=1
Begin DoDot:2
+32 DO EN^XPAR("SYS","OR RDI CACHE TIME",,Y)
End DoDot:2
End DoDot:1
+33 QUIT
HELP1 ;
+1 WRITE "Set this to ""YES"" if this system has an HDR system that"
+2 WRITE !," it uses to access remote data."
+3 QUIT
HELP3 ;
+1 WRITE "Set this to the number of minutes that the retrieved data is "
+2 WRITE !," to be considered valid for order checking purposes."
+3 QUIT
LIST ;
+1 WRITE !
+2 WRITE $$GET^XPAR("SYS","OR RDI HAVE HDR")," "
+3 WRITE $$GET^XPAR("SYS","OR RDI CACHE TIME")
+4 QUIT
CLEANUP ;
+1 NEW VAL,NOW,THRESH,DOM,DFN,TIME
+2 SET VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
+3 SET NOW=$$NOW^XLFDT
+4 SET THRESH=$$FMADD^XLFDT(NOW,,,-VAL)
+5 SET DFN=0
+6 FOR DOM="PSOO","ART"
FOR
SET DFN=$ORDER(^XTMP("ORRDI",DOM,DFN))
if 'DFN
QUIT
Begin DoDot:1
+7 SET TIME=$GET(^XTMP("ORRDI",DOM,DFN,0))
+8 IF TIME<THRESH
KILL ^XTMP("ORRDI",DOM,DFN)
End DoDot:1
+9 ;clear out metrics data older than 5 days
+10 NEW ORDT,ORDIFF
SET ORDT=0
+11 FOR
SET ORDT=$ORDER(^XTMP("ORRDI","METRICS",ORDT))
if 'ORDT
QUIT
SET ORDIFF=$$FMDIFF^XLFDT($$NOW^XLFDT,ORDT,1)
if ORDIFF<5
QUIT
KILL ^XTMP("ORRDI","METRICS",ORDT)
+12 ; checking if OUTAGE task crashed or hasn't completed successfully
+13 IF $$DOWNXVAL
Begin DoDot:1
+14 IF $$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)>($$PINGPVAL*2)
DO SPAWN^ORRDI2
End DoDot:1
+15 QUIT
DOWNRPC(ORY) ;can be used in an RPC to check if RDI is in an OUTAGE state (HDR DOWN)
+1 SET ORY=$$DOWNXVAL
+2 QUIT
DICNPVAL() ;parameter value for dummy patient ICN
+1 QUIT $$GET^XPAR("ALL","ORRDI DUMMY ICN")
FAILPVAL() ;parameter value for failure threshold
+1 QUIT $$GET^XPAR("ALL","ORRDI FAIL THRESH")
SUCCPVAL() ;parameter value for success threshold
+1 QUIT $$GET^XPAR("ALL","ORRDI SUCCEED THRESH")
PINGPVAL() ;parameter value for ping frequency
+1 QUIT $$GET^XPAR("ALL","ORRDI PING FREQ")
DOWNXVAL() ;xtmp value for OUTAGE state
+1 QUIT $GET(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
FAILXVAL() ;xtmp value for number of failed reads
+1 QUIT $GET(^XTMP("ORRDI","OUTAGE INFO","FAILURES"))
SUCCXVAL() ;xtmp value for number of successful reads
+1 QUIT $GET(^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS"))
PINGXVAL() ;xtmp value for last ping time
+1 QUIT $GET(^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING"))
LDPTTVAL(DFN) ;tmp value for if the local data only message has been shown to the user during ordering session
+1 QUIT $GET(^TMP($JOB,"ORRDI",DFN))
SPAWN ;subroutine to spawn the DOWNTSK task
+1 KILL ^XTMP("ORRDI","ART"),^XTMP("ORRDI","PSOO")
+2 NEW ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDTH
+3 SET ZTDESC="RDI TASK TO CHECK IF HDR IS UP"
+4 SET ZTRTN="DOWNTSK^ORRDI2"
+5 SET ZTIO="NULL"
+6 SET ZTDTH=$$NOW^XLFDT+.000001
+7 DO ^%ZTLOAD
+8 QUIT
DOWNTSK ;subroutine to check if HDR is back up
+1 NEW ORLE
SET ORLE=0
+2 SET ^XTMP("ORRDI","OUTAGE LOG",$$NOW^XLFDT)="GOING DOWN"
+3 FOR
if (($$SUCCXVAL'<$$SUCCPVAL)!('$$DOWNXVAL))
QUIT
Begin DoDot:1
+4 NEW WAIT,RSLT
+5 SET WAIT=$$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)
+6 SET WAIT=$$PINGPVAL-WAIT
+7 ;wait until the proper # of seconds has expired before retrying
+8 IF WAIT>0
HANG WAIT
+9 SET ^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING")=$$NOW^XLFDT
+10 ;send dummy message
+11 SET RSLT=$$TESTCALL
+12 ;if successful increment success counter
+13 IF RSLT=1
SET ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=1+$$SUCCXVAL
+14 ;if failure set success counter to 0
+15 IF RSLT'=1
SET ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=0
End DoDot:1
+16 KILL ^XTMP("ORRDI","OUTAGE INFO")
+17 SET ^XTMP("ORRDI","OUTAGE LOG",$$NOW^XLFDT)="BACK UP"
+18 QUIT
TCOLD() ;call to send a test call to CDS...returns 1 if successful, 0 OR -9 if not
+1 NEW ORREQ,ORXML,ORRET,XML,ORERR
+2 SET ORREQ="/isAlive"
+3 SET ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
+4 SET ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,1)
+5 IF 'ORRET
QUIT 0
+6
*** ERROR ***
+7 if XML="true"
QUIT 1
+8 QUIT 0
TESTCALL() ;call to send a test call to CDS...returns 1 if successful, 0 or -9 if not
+1 ;;CHANGE add ORERR to NEW list
NEW ORREQ,ORXML,ORRET,ORERR
+2 ;;CHANGE set error trap
NEW $ETRAP,$ESTACK
SET $ETRAP="DO ERRH^ORRDI2"
+3 ;USES isAlive IF NO TEST REQUEST IS PRESENT
IF $LENGTH($GET(^XTMP("ORRDI","TESTREQ")))'>0
QUIT $$TCOLD()
+4 SET ORREQ=$GET(^XTMP("ORRDI","TESTREQ"))
+5 SET ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
+6 ;;CHANGE change force error to 1
SET ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,1)
+7 IF 'ORRET
QUIT 0
+8 KILL ^TMP($JOB,"ORRDI")
+9 DO PARSE^ORRDI1(ORXML.HttpResponse.Data)
+10 IF $LENGTH($$MSGERR^ORRDI1)>0
KILL ^TMP($JOB,"ORRDI")
QUIT 0
+11 KILL ^TMP($JOB,"ORRDI")
+12 QUIT 1
ERRH ; error handler for TESTCALL/TCOLD
+1 ; create error object if needed
if '$DATA(ORERR)
SET ORERR=$$EOFAC^XOBWLIB()
+2 ;non-task: interactive error display
IF '+$GET(ZTSK)
DO ERRDISP^XOBWLIB(.ORERR)
WRITE !!
+3 ;ELSE I $G(ORLE)#15=0 DO ZTER^XOBWLIB(ORERR) ; tasked: expand into XOBEOARR, store in error log
+4 SET ORLE=$GET(ORLE)+1
+5 ; throw to MenuMan, TaskMan or next higher error handler
DO UNWIND^%ZTER
+6 QUIT
