Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORRDI2

ORRDI2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. SET ;utility to set RDI related parameters
  1. I '$$PATCH^XPDUTL("OR*3.0*238") D Q
  1. . W !,"This menu is locked until patch OR*3.0*238 is installed."
  1. N QUIT,QUITALL
  1. W !!,"Sets System wide parameters to control order checking against"
  1. W !," remote data",!
  1. F Q:$G(QUIT)!($G(QUITALL)) D
  1. . N VAL,VALEXT,DIR,DTOUT,Y
  1. . S VAL=$$GET^XPAR("SYS","OR RDI HAVE HDR")
  1. . S VALEXT="NO" I VAL=1 S VALEXT="YES"
  1. . S DIR("A")="HAVE AN HDR"
  1. . S DIR("B")=VALEXT
  1. . S DIR("?")="^D HELP1^ORRDI2"
  1. . S DIR(0)="Y"
  1. . D ^DIR
  1. . I $G(Y)="^"!($G(DTOUT)) S QUITALL=1
  1. . I $G(Y)=1!($G(Y)=0) S QUIT=1 D
  1. . . D EN^XPAR("SYS","OR RDI HAVE HDR",,Y)
  1. I $G(QUITALL) Q
  1. I '$$GET^XPAR("SYS","OR RDI HAVE HDR") Q
  1. S QUIT=0
  1. F Q:$G(QUIT)!($G(QUITALL)) D
  1. . N VAL,VALEXT,DIR,DTOUT,Y
  1. . S VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
  1. . S VALEXT=$G(VAL,0)
  1. . S DIR("A")="CACHE TIME (Minutes)"
  1. . S DIR("B")=VALEXT
  1. . S DIR("?")="^D HELP3^ORRDI2"
  1. . S DIR(0)="N^0:9999:0"
  1. . D ^DIR
  1. . I $G(Y)="^"!($G(DTOUT)) S QUITALL=1
  1. . I $G(Y)>-1 S QUIT=1 D
  1. . . D EN^XPAR("SYS","OR RDI CACHE TIME",,Y)
  1. Q
  1. HELP1 ;
  1. W "Set this to ""YES"" if this system has an HDR system that"
  1. W !," it uses to access remote data."
  1. Q
  1. HELP3 ;
  1. W "Set this to the number of minutes that the retrieved data is "
  1. W !," to be considered valid for order checking purposes."
  1. Q
  1. LIST ;
  1. W !
  1. W $$GET^XPAR("SYS","OR RDI HAVE HDR")," "
  1. W $$GET^XPAR("SYS","OR RDI CACHE TIME")
  1. Q
  1. CLEANUP ;
  1. N VAL,NOW,THRESH,DOM,DFN,TIME
  1. S VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
  1. S NOW=$$NOW^XLFDT
  1. S THRESH=$$FMADD^XLFDT(NOW,,,-VAL)
  1. S DFN=0
  1. F DOM="PSOO","ART" F S DFN=$O(^XTMP("ORRDI",DOM,DFN)) Q:'DFN D
  1. . S TIME=$G(^XTMP("ORRDI",DOM,DFN,0))
  1. . I TIME<THRESH K ^XTMP("ORRDI",DOM,DFN)
  1. ;clear out metrics data older than 5 days
  1. N ORDT,ORDIFF S ORDT=0
  1. 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)
  1. ; checking if OUTAGE task crashed or hasn't completed successfully
  1. I $$DOWNXVAL D
  1. .I $$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)>($$PINGPVAL*2) D SPAWN^ORRDI2
  1. Q
  1. DOWNRPC(ORY) ;can be used in an RPC to check if RDI is in an OUTAGE state (HDR DOWN)
  1. S ORY=$$DOWNXVAL
  1. Q
  1. DICNPVAL() ;parameter value for dummy patient ICN
  1. Q $$GET^XPAR("ALL","ORRDI DUMMY ICN")
  1. FAILPVAL() ;parameter value for failure threshold
  1. Q $$GET^XPAR("ALL","ORRDI FAIL THRESH")
  1. SUCCPVAL() ;parameter value for success threshold
  1. Q $$GET^XPAR("ALL","ORRDI SUCCEED THRESH")
  1. PINGPVAL() ;parameter value for ping frequency
  1. Q $$GET^XPAR("ALL","ORRDI PING FREQ")
  1. DOWNXVAL() ;xtmp value for OUTAGE state
  1. Q $G(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
  1. FAILXVAL() ;xtmp value for number of failed reads
  1. Q $G(^XTMP("ORRDI","OUTAGE INFO","FAILURES"))
  1. SUCCXVAL() ;xtmp value for number of successful reads
  1. Q $G(^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS"))
  1. PINGXVAL() ;xtmp value for last ping time
  1. Q $G(^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING"))
  1. LDPTTVAL(DFN) ;tmp value for if the local data only message has been shown to the user during ordering session
  1. Q $G(^TMP($J,"ORRDI",DFN))
  1. SPAWN ;subroutine to spawn the DOWNTSK task
  1. K ^XTMP("ORRDI","ART"),^XTMP("ORRDI","PSOO")
  1. N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDTH
  1. S ZTDESC="RDI TASK TO CHECK IF HDR IS UP"
  1. S ZTRTN="DOWNTSK^ORRDI2"
  1. S ZTIO="NULL"
  1. S ZTDTH=$$NOW^XLFDT+.000001
  1. D ^%ZTLOAD
  1. Q
  1. DOWNTSK ;subroutine to check if HDR is back up
  1. N ORLE S ORLE=0
  1. S ^XTMP("ORRDI","OUTAGE LOG",$$NOW^XLFDT)="GOING DOWN"
  1. F Q:(($$SUCCXVAL'<$$SUCCPVAL)!('$$DOWNXVAL)) D
  1. .N WAIT,RSLT
  1. .S WAIT=$$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)
  1. .S WAIT=$$PINGPVAL-WAIT
  1. .;wait until the proper # of seconds has expired before retrying
  1. .I WAIT>0 H WAIT
  1. .S ^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING")=$$NOW^XLFDT
  1. .;send dummy message
  1. .S RSLT=$$TESTCALL
  1. .;if successful increment success counter
  1. .I RSLT=1 S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=1+$$SUCCXVAL
  1. .;if failure set success counter to 0
  1. .I RSLT'=1 S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=0
  1. K ^XTMP("ORRDI","OUTAGE INFO")
  1. S ^XTMP("ORRDI","OUTAGE LOG",$$NOW^XLFDT)="BACK UP"
  1. Q
  1. TCOLD() ;call to send a test call to CDS...returns 1 if successful, 0 OR -9 if not
  1. N ORREQ,ORXML,ORRET,XML,ORERR
  1. S ORREQ="/isAlive"
  1. S ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
  1. S ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,1)
  1. I 'ORRET Q 0
  1. While (ORXML.HttpResponse.Data.AtEnd = 0) {S XML=ORXML.HttpResponse.Data.Read(100)}
  1. Q:XML="true" 1
  1. Q 0
  1. TESTCALL() ;call to send a test call to CDS...returns 1 if successful, 0 or -9 if not
  1. N ORREQ,ORXML,ORRET,ORERR ;;CHANGE add ORERR to NEW list
  1. N $ETRAP,$ESTACK SET $ETRAP="DO ERRH^ORRDI2" ;;CHANGE set error trap
  1. I $L($G(^XTMP("ORRDI","TESTREQ")))'>0 Q $$TCOLD() ;USES isAlive IF NO TEST REQUEST IS PRESENT
  1. S ORREQ=$G(^XTMP("ORRDI","TESTREQ"))
  1. S ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
  1. S ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,1) ;;CHANGE change force error to 1
  1. I 'ORRET Q 0
  1. K ^TMP($J,"ORRDI")
  1. D PARSE^ORRDI1(ORXML.HttpResponse.Data)
  1. I $L($$MSGERR^ORRDI1)>0 K ^TMP($J,"ORRDI") Q 0
  1. K ^TMP($J,"ORRDI")
  1. Q 1
  1. ERRH ; error handler for TESTCALL/TCOLD
  1. SET:'$DATA(ORERR) ORERR=$$EOFAC^XOBWLIB() ; create error object if needed
  1. IF '+$GET(ZTSK) DO ERRDISP^XOBWLIB(.ORERR) W !! ;non-task: interactive error display
  1. ;ELSE I $G(ORLE)#15=0 DO ZTER^XOBWLIB(ORERR) ; tasked: expand into XOBEOARR, store in error log
  1. S ORLE=$G(ORLE)+1
  1. DO UNWIND^%ZTER ; throw to MenuMan, TaskMan or next higher error handler
  1. QUIT