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 ; 1/11/07 8:12am
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232**;Dec 17, 1997;Build 19
  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.  ; 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. PIECEOUT(Y,DATA,DEL) ;
  1.  K Y
  1.  N I,J,COUNT
  1.  S I="",COUNT=0 F  S I=$O(DATA(I)) Q:I=""  D
  1.  . S J=0 F  S J=J+1 Q:J>$L(DATA(I),DEL)  D
  1.  .. I COUNT>0,J=1 S Y(COUNT)=Y(COUNT)_$P(DATA(I),DEL,J) Q
  1.  .. S COUNT=COUNT+1,Y(COUNT)=$P(DATA(I),DEL,J)
  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=""
  1.  S ZTDTH=$$NOW^XLFDT+.000001
  1.  D ^%ZTLOAD
  1.  Q
  1. DOWNTSK ;subroutine to check if HDR is back up
  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 S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=1+$$SUCCXVAL
  1.  .;if failure set success counter to 0
  1.  .I 'RSLT S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=0
  1.  K ^XTMP("ORRDI","OUTAGE INFO")
  1.  Q
  1. TESTCALL() ;call to send a test call to CDS...returns 1 if successful, 0 if not
  1.  N START,END,HLL,HLA,ORFS,ORCS,ORRS,ORES,ORSS
  1.  N Y,ORRSLT,ICN,WHATOUT,HLNEXT,HLNODE,HLQUIT,ORHLP,RET,HL,HLDOM,HLDONE1,HLECH,HLFS,HLINSTN,HLMTIEN,HLPARAM,HLQ,STATUS,PRE
  1.  S (ORFS,ORCS,ORRS,ORES,ORSS)=""
  1.  S START=$P($$NOW^XLFDT,".")
  1.  ;build HLA array with request HL7
  1.  S HLA("HLS",1)="SPR^XWBDRPC845-569716_0^T^ZREMOTE RPC^@SPR.4.2~003RPC017ORWRP REPORT TEXT&006RPCVER0010&007XWBPCNT0017&007XWBESSO066321214321\F\\F\\F\657\F"
  1.  S HLA("HLS",1,1)="\48102&007XWBDVER0011&006XWBSEC0043.14&002P10187369543;"_$$DICNPVAL_"&002P2039OC_AL:ALLERGIES;1\S\RXOP;ORDV06;28;200&002P3000&002P4000&002P5000&002P600"_$L($G(START))_$G(START)_"&002P700"_$L($G(END))_$G(END)
  1.  S HLA("HLS",2)="RDF^1^@DSP.3~TX~300"
  1.  ;set HLL("LINKS") node to specify receiver location
  1.  S HLL("LINKS",1)="ORRDI SUBSCRIBER^ORHDR"
  1.  S ORHLP("OPEN TIMEOUT")=10
  1.  S ORHLP("SUBSCRIBER")="^OR RDI SENDER^"_$P($$SITE^VASITE,U,3)_"^OR RDI RECEIVER^^^"
  1.  ;call DIRECT^HLMA to send request
  1.  D DIRECT^HLMA("ORRDI EVENT","LM",1,.ORRSLT,,.ORHLP)
  1.  ;check if call failed
  1.  I $P($G(ORRSLT),U,2) Q 0
  1.  Q 1