- 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 Feb 19, 2025@00:00:29 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