source: ePrescribing/trunk/p/C0PTRAK.m@ 1696

Last change on this file since 1696 was 1595, checked in by George Lilly, 12 years ago

initial release of ePrescribing
File size: 4.6 KB
Line 
1C0PTRAK ;KBAZ/ZAG/GPL - eRx debugging utilities; 4/1/2012 ; 5/8/12 5:12pm
2 ;;1.0;C0P;;Apr 25, 2012;Build 84
3 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 QUIT ;do not call from the top
21 ;
22 ;INTRP(JOB) ;send interrupt to an interactive job.
23 ;
24LOG(JOB,TAG) ;send interrupt and log results
25 ;copied from ZJOB to here for silently interrupting one job.
26 N $ET,$ES S $ET="D IRTERR^ZJOB"
27 ; shouldn't interrupt ourself, but commented out to test
28 ;I JOB=$JOB Q 0
29 ;We need a LOCK to guarantee commands from two processes don't conflict
30 N X,OLDINTRPT,TMP,ZSYSCMD,ZPATH,%J
31 L +^XUTL("XUSYS","COMMAND"):10 Q:'$T 0
32 ;
33 S ^XUTL("XUSYS","COMMAND")="EXAM",^("COMMAND",0)=$J_":"_$H
34 K ^XUTL("XUSYS",JOB,"JE")
35 S OLDINTRP=$ZINTERRUPT,%J=$J
36 S TMP=0,$ZINTERRUPT="S TMP=1"
37 ;
38 ;convert PID for VMS systems
39 I $ZV["VMS" D
40 . S JOB=$$FUNC^%DH(JOB,8)
41 . S %J=$$FUNC^%DH(%J,8)
42 ;
43 S ZSYSCMD="mupip intrpt "_JOB_" > /dev/null 2>&1" ; interrupt other job
44 I $ZV["VMS" S ZPATH="@gtm$dist:" ; VMS path
45 E S ZPATH="$gtm_dist/" ;Unix path
46 ZSYSTEM ZPATH_ZSYSCMD ; System Request
47 ;Now send to self
48 ; wait is too long 60>>30
49 H 1 S TMP=1 ; wait for interrupt, will set TMP=1
50 ;
51 ; Restore old $ZINTERRPT
52 S $ZINTERRUPT=OLDINTRP
53 K ^XUTL("XUSYS","COMMAND") ;Cleanup
54 L -^XUTL("XUSYS","COMMAND")
55 ;get values to report back on
56 K ^TMP("C0PERXLOG",JOB)
57 M ^TMP("C0PERXLOG",JOB)=^XUTL("XUSYS",JOB) ;merge off array for reporting
58 S ^TMP("C0PERXLOG",JOB,"LOGPOINT")=$G(TAG)
59 ;
60 ;D LOG(JOB) ;create the C0PLOG
61 ;K ^C0PTRAK(JOB) ;clean up temp log
62 ;
63 QUIT ;end of INTRP
64 ;
65NEWLOG(JOB,TAG) ;report on JOB interrupted
66 ; TAG identifies the location creating the log. it is text
67 K ^C0PLOG(JOB)
68 N VARLOG ;build variable log array for further inspection
69 N VARTYP S VARTYP=""
70 F D Q:VARTYP=""
71 . S VARTYP=$O(^KBAZ(JOB,VARTYP)) ;type of variable
72 . Q:VARTYP="" ;exit if no more variable are types found
73 . N VARCNT S VARCNT=""
74 . F D Q:'VARCNT
75 . . S VARCNT=$O(^KBAZ(JOB,VARTYP,VARCNT)) ;variable count
76 . . Q:'VARCNT ;exit if no more variables are found
77 . . N VAR S VAR=$G(^KBAZ(JOB,VARTYP,VARCNT)) ;get the variable
78 . . N VARNM S VARNM=$P(VAR,"=") ;variable name
79 . . N VARIABLE S VARIABLE=$P(VAR,"=",2)
80 . . S VARIABLE=$TR(VARIABLE,"""") ;remove the extra quotes
81 . . S VARLOG(VARNM)=VARIABLE ;variable
82 . . N %H S %H=$G(VARLOG("$HOROLOG")) ;current $H
83 . . N PC S PC=$G(VARLOG("IO(""CLNM"")")) ;pc/client name
84 . . N IP S IP=$G(VARLOG("IO(""GTM-IP"")")) ;pc/client IP address
85 . . N USER S USER=$G(VARLOG("DUZ")) ;current user
86 . . N CURPAT S CURPAT=$G(VARLOG("VALUE(2)")) ;current patient
87 . . ;
88 . . ;build the final log
89 . . S ^TMP("C0PERXLOG",JOB,"LOGPOINT")=$G(TAG)
90 . . S ^TMP("C0PERXLOG",JOB,"TIME")=$$HTE^XLFDT(%H)
91 . . S ^TMP("C0PERXLOG",JOB,"CLNM")=PC
92 . . S ^TMP("C0PERXLOG",JOB,"IP")=IP
93 . . S ^TMP("C0PERXLOG",JOB,"DUZ")=USER
94 . . S ^TMP("C0PERXLOG",JOB,"PT")=CURPAT
95 ;
96 QUIT ;end of LOG
97 ;
98 ;
99UNLOG(JOB) ; clean up a log entry
100 K ^TMP("C0PERXLOG",JOB)
101 Q
102 ;
103RUNAWAY ; called from Batch to kill runaway eRx jobs
104 ; looks at every entry in the table looking for marked jobs to kill
105 ; if a job is not marked, it will mark it so that next time it
106 ; will be killed.
107 ; This insures that jobs logged to the table have at least 15 minutes
108 ; to unlog or they will be killed.
109 ; this is implemented to catch and kill runaway eRX webservice calls
110 ; uses STOP^XVJK($JOB) written by Zach Gonzales to kill jobs in GT.M linux
111 ; gpl 4/18/2012
112 ;
113 N GN,ZI
114 S GN=$NA(^TMP("C0PERXLOG"))
115 S GNOLD=$NA(^TMP("C0POLDLOG"))
116 S ZI=""
117 F S ZI=$O(@GN@(ZI)) Q:+ZI=0 D ; for every entry in the table
118 . I $D(@GN@(ZI,"KILLED")) Q ; job already killed
119 . I $D(@GN@(ZI,"MARKED")) D Q ; found a job to kill then quit
120 . . D STOP^XVJK(ZI) ; kill the job
121 . . S @GN@(ZI,"KILLED")=$$NOW^XLFDT ; record the kill
122 . . S @GN@(ZI,"KILLEDBY")=DUZ
123 . . M @GNOLD@(ZI,$H)=@GN@(ZI)
124 . . K @GN@(ZI)
125 . S @GN@(ZI,"MARKED")=$$NOW^XLFDT ; mark for a kill next time
126 Q
127 ;
128EOR ;end of C0PTRAK
Note: See TracBrowser for help on using the repository browser.