source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORRDI2.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1ORRDI2 ; SLC/JMH - RDI routine for user interface and data cleanup; 3/24/05 2:31 ; 1/11/07 8:12am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232**;Dec 17, 1997;Build 19
3 ;
4SET ;utility to set RDI related parameters
5 I '$$PATCH^XPDUTL("OR*3.0*238") D Q
6 . W !,"This menu is locked until patch OR*3.0*238 is installed."
7 N QUIT,QUITALL
8 W !!,"Sets System wide parameters to control order checking against"
9 W !," remote data",!
10 F Q:$G(QUIT)!($G(QUITALL)) D
11 . N VAL,VALEXT,DIR,DTOUT,Y
12 . S VAL=$$GET^XPAR("SYS","OR RDI HAVE HDR")
13 . S VALEXT="NO" I VAL=1 S VALEXT="YES"
14 . S DIR("A")="HAVE AN HDR"
15 . S DIR("B")=VALEXT
16 . S DIR("?")="^D HELP1^ORRDI2"
17 . S DIR(0)="Y"
18 . D ^DIR
19 . I $G(Y)="^"!($G(DTOUT)) S QUITALL=1
20 . I $G(Y)=1!($G(Y)=0) S QUIT=1 D
21 . . D EN^XPAR("SYS","OR RDI HAVE HDR",,Y)
22 I $G(QUITALL) Q
23 I '$$GET^XPAR("SYS","OR RDI HAVE HDR") Q
24 S QUIT=0
25 F Q:$G(QUIT)!($G(QUITALL)) D
26 . N VAL,VALEXT,DIR,DTOUT,Y
27 . S VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
28 . S VALEXT=$G(VAL,0)
29 . S DIR("A")="CACHE TIME (Minutes)"
30 . S DIR("B")=VALEXT
31 . S DIR("?")="^D HELP3^ORRDI2"
32 . S DIR(0)="N^0:9999:0"
33 . D ^DIR
34 . I $G(Y)="^"!($G(DTOUT)) S QUITALL=1
35 . I $G(Y)>-1 S QUIT=1 D
36 . . D EN^XPAR("SYS","OR RDI CACHE TIME",,Y)
37 Q
38HELP1 ;
39 W "Set this to ""YES"" if this system has an HDR system that"
40 W !," it uses to access remote data."
41 Q
42HELP3 ;
43 W "Set this to the number of minutes that the retrieved data is "
44 W !," to be considered valid for order checking purposes."
45 Q
46LIST ;
47 W !
48 W $$GET^XPAR("SYS","OR RDI HAVE HDR")," "
49 W $$GET^XPAR("SYS","OR RDI CACHE TIME")
50 Q
51CLEANUP ;
52 N VAL,NOW,THRESH,DOM,DFN,TIME
53 S VAL=$$GET^XPAR("SYS","OR RDI CACHE TIME")
54 S NOW=$$NOW^XLFDT
55 S THRESH=$$FMADD^XLFDT(NOW,,,-VAL)
56 S DFN=0
57 F DOM="PSOO","ART" F S DFN=$O(^XTMP("ORRDI",DOM,DFN)) Q:'DFN D
58 . S TIME=$G(^XTMP("ORRDI",DOM,DFN,0))
59 . I TIME<THRESH K ^XTMP("ORRDI",DOM,DFN)
60 ; checking if OUTAGE task crashed or hasn't completed successfully
61 I $$DOWNXVAL D
62 .I $$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)>($$PINGPVAL*2) D SPAWN^ORRDI2
63 Q
64PIECEOUT(Y,DATA,DEL) ;
65 K Y
66 N I,J,COUNT
67 S I="",COUNT=0 F S I=$O(DATA(I)) Q:I="" D
68 . S J=0 F S J=J+1 Q:J>$L(DATA(I),DEL) D
69 .. I COUNT>0,J=1 S Y(COUNT)=Y(COUNT)_$P(DATA(I),DEL,J) Q
70 .. S COUNT=COUNT+1,Y(COUNT)=$P(DATA(I),DEL,J)
71 Q
72DOWNRPC(ORY) ;can be used in an RPC to check if RDI is in an OUTAGE state (HDR DOWN)
73 S ORY=$$DOWNXVAL
74 Q
75DICNPVAL() ;parameter value for dummy patient ICN
76 Q $$GET^XPAR("ALL","ORRDI DUMMY ICN")
77FAILPVAL() ;parameter value for failure threshold
78 Q $$GET^XPAR("ALL","ORRDI FAIL THRESH")
79SUCCPVAL() ;parameter value for success threshold
80 Q $$GET^XPAR("ALL","ORRDI SUCCEED THRESH")
81PINGPVAL() ;parameter value for ping frequency
82 Q $$GET^XPAR("ALL","ORRDI PING FREQ")
83DOWNXVAL() ;xtmp value for OUTAGE state
84 Q $G(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
85FAILXVAL() ;xtmp value for number of failed reads
86 Q $G(^XTMP("ORRDI","OUTAGE INFO","FAILURES"))
87SUCCXVAL() ;xtmp value for number of successful reads
88 Q $G(^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS"))
89PINGXVAL() ;xtmp value for last ping time
90 Q $G(^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING"))
91LDPTTVAL(DFN) ;tmp value for if the local data only message has been shown to the user during ordering session
92 Q $G(^TMP($J,"ORRDI",DFN))
93SPAWN ;subroutine to spawn the DOWNTSK task
94 K ^XTMP("ORRDI","ART"),^XTMP("ORRDI","PSOO")
95 N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDTH
96 S ZTDESC="RDI TASK TO CHECK IF HDR IS UP"
97 S ZTRTN="DOWNTSK^ORRDI2"
98 S ZTIO=""
99 S ZTDTH=$$NOW^XLFDT+.000001
100 D ^%ZTLOAD
101 Q
102DOWNTSK ;subroutine to check if HDR is back up
103 F Q:(($$SUCCXVAL'<$$SUCCPVAL)!('$$DOWNXVAL)) D
104 .N WAIT,RSLT
105 .S WAIT=$$FMDIFF^XLFDT($$NOW^XLFDT,$$PINGXVAL,2)
106 .S WAIT=$$PINGPVAL-WAIT
107 .;wait until the proper # of seconds has expired before retrying
108 .I WAIT>0 H WAIT
109 .S ^XTMP("ORRDI","OUTAGE INFO","DOWN","LAST PING")=$$NOW^XLFDT
110 .;send dummy message
111 .S RSLT=$$TESTCALL
112 .;if successful increment success counter
113 .I RSLT S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=1+$$SUCCXVAL
114 .;if failure set success counter to 0
115 .I 'RSLT S ^XTMP("ORRDI","OUTAGE INFO","SUCCEEDS")=0
116 K ^XTMP("ORRDI","OUTAGE INFO")
117 Q
118TESTCALL() ;call to send a test call to CDS...returns 1 if successful, 0 if not
119 N START,END,HLL,HLA,ORFS,ORCS,ORRS,ORES,ORSS
120 N Y,ORRSLT,ICN,WHATOUT,HLNEXT,HLNODE,HLQUIT,ORHLP,RET,HL,HLDOM,HLDONE1,HLECH,HLFS,HLINSTN,HLMTIEN,HLPARAM,HLQ,STATUS,PRE
121 S (ORFS,ORCS,ORRS,ORES,ORSS)=""
122 S START=$P($$NOW^XLFDT,".")
123 ;build HLA array with request HL7
124 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"
125 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)
126 S HLA("HLS",2)="RDF^1^@DSP.3~TX~300"
127 ;set HLL("LINKS") node to specify receiver location
128 S HLL("LINKS",1)="ORRDI SUBSCRIBER^ORHDR"
129 S ORHLP("OPEN TIMEOUT")=10
130 S ORHLP("SUBSCRIBER")="^OR RDI SENDER^"_$P($$SITE^VASITE,U,3)_"^OR RDI RECEIVER^^^"
131 ;call DIRECT^HLMA to send request
132 D DIRECT^HLMA("ORRDI EVENT","LM",1,.ORRSLT,,.ORHLP)
133 ;check if call failed
134 I $P($G(ORRSLT),U,2) Q 0
135 Q 1
Note: See TracBrowser for help on using the repository browser.