324 lines
8.7 KiB
Mathematica
324 lines
8.7 KiB
Mathematica
HLEVSRV ;O-OIFO/LJA - Event Monitor SERVER ;02/04/2004 14:42
|
|
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
|
|
;
|
|
; Send email to S.XQSCHK@SITE.VA.GOV to check server status.
|
|
; (Include the name of server (w/o S.) in body of message.)
|
|
;
|
|
SERVER ; Called to get information about local monitoring system
|
|
N ADDREQHD,MXEC,NOW,XMER,XMPOS,XMRG,XTMP
|
|
;
|
|
;[M]S MXEC=$$MST^HLEVSRV1 ; Is M code execution allowed?
|
|
;
|
|
S NOW=$$NOW^XLFDT,XTMP="HLEV SERVER "_NOW
|
|
S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,2)_U_NOW_"^HLEV SERVER REQUEST^"_$G(XMFROM)
|
|
;
|
|
I $G(XMZ)'>0!($G(XMREC)']"") D QUIT ;->
|
|
. S ^XTMP(XTMP,"ERR")="No XMZ or XMREC"
|
|
;
|
|
S ^XTMP(XTMP,"MAIL")=XMZ
|
|
;
|
|
S XMPOS=""
|
|
;
|
|
READ ; Sequentially read thru message
|
|
X XMREC
|
|
I $D(XMER) G PROCESS:XMER<0 ;->
|
|
D ADDLINE(XMRG)
|
|
G READ ;->
|
|
;
|
|
;======================================================================
|
|
;
|
|
PROCESS ; Multiple "data request" formats possible...
|
|
;[M]; MXEC -- req
|
|
N SUB
|
|
;
|
|
D EXTRACT
|
|
D REQBACK ; Echo what was requested
|
|
;
|
|
;[M]S MXEC=$P(MXEC,U)+$P(MXEC,U,4)
|
|
;[M]I MXEC=2 D QUIT:$G(HLEVQUIT) ;-> Pre-load M code execution
|
|
;[M]. D MPRE^HLEVSRV0
|
|
D LOADATA
|
|
;[M]I MXEC=2 D QUIT:$G(HLEVQUIT) ;-> Post-load M code execution
|
|
;[M]. D MPST^HLEVSRV0
|
|
;[M]. D MCOND^HLEVSRV0
|
|
;[M]. D MCALLREC^HLEVSRV0
|
|
;[M]. D MTEXT^HLEVSRV0
|
|
D XTMPMAIL ; Place at bottom of message XTMP value
|
|
D MAILIT
|
|
D KILLS
|
|
;
|
|
Q
|
|
;
|
|
;======================================================================
|
|
;
|
|
EXTRACT ; Extract out the work list...
|
|
; XTMP -- req
|
|
N CT,FILE,LNO,TXT
|
|
S LNO=0,CT=0
|
|
F S LNO=$O(^XTMP(XTMP,"RQ",LNO)) Q:LNO'>0 D
|
|
. S TXT=$$CHKREQ($G(^XTMP(XTMP,"RQ",LNO))) QUIT:TXT']"" ;->
|
|
. S FILE=$P(TXT,U) ; Type of request in "FILE"...
|
|
.
|
|
. ; There are 3 types of "data requests"...
|
|
. I FILE="QUERY" D EXTQUERY($P(TXT,U,2,99)) QUIT ;-> $QUERY format...
|
|
. I FILE="UNIT" D UNIT^HLEVSRV0($P(TXT,U,2,99)) QUIT ;-> Msg ID
|
|
. I $$OKFILE(+FILE) D EXTFILE(TXT) QUIT ;->
|
|
.
|
|
. ; If not a data request, must be a non-VistA HL7 request. And,
|
|
. ; if so, they have to pass a license
|
|
. I FILE="LICENSE" D CHKLIC^HLEVSRV4($P(TXT,U,2,99),$G(XMFROM)) QUIT ;->
|
|
.
|
|
. D ADDREQHD,ADDREQ("Error (HEADER)^"_TXT)
|
|
Q
|
|
;
|
|
CHKREQ(TXT) ; Check request, strip comments, etc...
|
|
N I
|
|
;
|
|
; Strip comments...
|
|
I $L(TXT,";")>1 S TXT=$P(TXT,";",1,$L(TXT,";")-1)
|
|
;
|
|
; Ignore blank lines, and dashed lines...
|
|
QUIT:$TR(TXT," -=;")']"" "" ;->
|
|
;
|
|
; Strip leading and trailing spaces...
|
|
X "F I=1:1:$L(TXT) Q:$E(TXT,I)'="" """ S TXT=$E(TXT,I,999) ; Leading
|
|
X "F I=$L(TXT):-1:1 Q:$E(TXT,I)'="" """ S TXT=$E(TXT,1,I) ; Trailing
|
|
;
|
|
Q TXT
|
|
;
|
|
LOADATA ; Process the work list...
|
|
D LOADFNO
|
|
D LOADQRY
|
|
D LOADUNIT^HLEVSRV0 ; Msg ID-related data
|
|
D GBLTOXM^HLEVSRV1 ; 776 format data to send back
|
|
Q
|
|
;
|
|
LOADFNO ; Load data from file number...
|
|
N FILE,NODE,WHAT
|
|
D ADDMAIL("")
|
|
S FILE=0
|
|
F S FILE=$O(^XTMP(XTMP,"HLEV PROC","F",FILE)) Q:FILE'>0 D
|
|
. S WHAT=""
|
|
. F S WHAT=$O(^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT)) Q:WHAT']"" D
|
|
. . S NODE=""
|
|
. . F S NODE=$O(^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT,NODE)) Q:NODE']"" D
|
|
. . . S LIMIT=$G(^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT,NODE))
|
|
. . . D LOAD(FILE,WHAT,NODE,LIMIT)
|
|
Q
|
|
;
|
|
LOADQRY ; Load $QUERY data...
|
|
N NO
|
|
;
|
|
QUIT:'$D(^XTMP(XTMP,"HLQUERY")) ;->
|
|
D ADDMAIL("")
|
|
D ADDMAIL("$QUERY Data"),ADDMAIL($$REPEAT^XLFSTR("-",74))
|
|
;
|
|
; Load $QUERY format data...
|
|
S NO=0
|
|
F S NO=$O(^XTMP(XTMP,"HLQUERY",NO)) Q:NO'>0 D
|
|
. D LOADQ(^XTMP(XTMP,"HLQUERY",+NO))
|
|
;
|
|
Q
|
|
;
|
|
REQBACK ; Send back what was requested...
|
|
N SNO
|
|
;
|
|
S SNO=0
|
|
F S SNO=$O(^XTMP(XTMP,"HLREQ",SNO)) Q:SNO'>0 D
|
|
. D ADDMAIL(^XTMP(XTMP,"HLREQ",SNO))
|
|
;
|
|
Q
|
|
;
|
|
XTMPMAIL ; Add XTMP reference to bottom of email...
|
|
D ADDMAIL(""),ADDMAIL("")
|
|
D ADDMAIL("Remote request by: "_$G(XMFROM)),ADDMAIL("")
|
|
D ADDMAIL("[Query log stored in ^XTMP("""_XTMP_""") at site.]")
|
|
Q
|
|
;
|
|
MAILIT ; Mail report back to HL7 mail group...
|
|
; XTMP -- req
|
|
N NO,TEXT,X,XMDUZ,XMSUB,XMTEXT,XMZ
|
|
S XMDUZ=.5,XMTEXT="^XTMP("""_XTMP_""",""HLMAIL"","
|
|
S X=$$SITE^VASITE,XMSUB="HLEV SERVER REQUEST "_$P(X,U,2)_" [#"_$P(X,U,3)_"]"
|
|
;
|
|
; Only send to VistA HL7 team members!!!!
|
|
S XMY("HL7SystemMonitoring@med.va.gov")=""
|
|
;
|
|
D ^XMD
|
|
;
|
|
S $P(^XTMP(XTMP,"MAIL"),U,2)=$G(XMZ)
|
|
;
|
|
QUIT
|
|
;
|
|
KILLS ; Remove unwanted ^XTMP subscripts...
|
|
F SUB="DATA","HLEV PROC","HLMAIL","HLUNIT","HLQUERY","HLREQ","M","MTXT" D
|
|
. KILL ^XTMP(XTMP,SUB)
|
|
;
|
|
Q
|
|
;
|
|
; =====================================================================
|
|
;
|
|
LOAD(FILE,WHAT,NODE,LIMIT) ;
|
|
N CT,DATA,GBL,IEN
|
|
;
|
|
S LIMIT=$G(LIMIT)
|
|
S GBL=$$GBLFILE(+FILE) QUIT:GBL']"" ;->
|
|
;
|
|
; If passed in an IEN...
|
|
I WHAT=+WHAT D LOADONE(FILE,+WHAT,NODE),ADDMAIL("")
|
|
;
|
|
; Check to make sure it is ALL...
|
|
QUIT:WHAT'["ALL" ;->
|
|
;
|
|
S IEN=0,CT=0,LIMIT=$S(LIMIT:LIMIT,1:99999)
|
|
F S IEN=$O(@GBL@(IEN)) Q:IEN'>0!(CT>(LIMIT-1)) D
|
|
. D LOADONE(FILE,+IEN,NODE,LIMIT)
|
|
. S CT=CT+1
|
|
;
|
|
I CT D ADDMAIL("")
|
|
;
|
|
Q
|
|
;
|
|
LOADONE(FILE,IEN,NODE,LIMIT) ; Load one entry...
|
|
N DATA,GBL,MIEN,MONM,ND,TXT
|
|
;
|
|
S LIMIT=$G(LIMIT)
|
|
S GBL=$$GBLFILE(+FILE) QUIT:GBL']"" ;->
|
|
;
|
|
; Node (not multiple or WP) requested...
|
|
I $D(@GBL@(+IEN,NODE))#2 D QUIT ;->
|
|
. S DATA=$G(@GBL@(+IEN,NODE))
|
|
. S ^XTMP(XTMP,"DATA",FILE,+IEN,NODE)=DATA
|
|
;
|
|
Q
|
|
;
|
|
; =====================================================================
|
|
;
|
|
EXTFILE(TXT) ; Extract 776 data...
|
|
N FILE,GBL,LIMIT,LOOPI,NODES,WHAT
|
|
;
|
|
; Sets...
|
|
S FILE=+TXT,GBL=$$GBLFILE(FILE) QUIT:GBL']"" ;->
|
|
S WHAT=$P(TXT,U,2)
|
|
I WHAT']"" S WHAT="ALL"
|
|
I WHAT=+WHAT QUIT:$G(@GBL@(+WHAT,0))']"" ;->
|
|
S NODES=$TR($P(TXT,U,3),"~",U),LIMIT=$P(TXT,U,4)
|
|
;
|
|
; Build nodes requested list...
|
|
F LOOPI=1:1:$L(NODES,U) S NODE=$P(NODES,U,LOOPI) I NODE]"" D
|
|
. S ^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT,NODE)=LIMIT
|
|
. D ADDREQHD
|
|
. S TXT=$E("[#1] "_FILE_$S(LIMIT:" #"_LIMIT,1:"")_$$REPEAT^XLFSTR(" ",18),1,18)
|
|
. I LOOPI>1 S LIMIT=""
|
|
. S TXT=TXT_$E("[#2] "_$S(WHAT=+WHAT:"#"_WHAT,1:WHAT)_$$REPEAT^XLFSTR(" ",18),1,18)
|
|
. S TXT=TXT_"[#3] "_NODE
|
|
. D ADDREQ(TXT)
|
|
;
|
|
Q
|
|
;
|
|
GBLFILE(FILE) ; Return closed global root...
|
|
N CH,GBL
|
|
S GBL=$G(^DIC(+FILE,0,"GL"))
|
|
S CH=$E(GBL,$L(GBL))
|
|
I CH="," QUIT $E(GBL,1,$L(GBL)-1)_")" ;->
|
|
I CH="(" QUIT $E(GBL,1,$L(GBL)-1)
|
|
Q ""
|
|
;
|
|
EXTQUERY(VAL) ; Extract $QUERY format requests...
|
|
;
|
|
; Format: p(1) = $QUERY reference. (E.g., "^DPT(25)")
|
|
; p(2) = $QUERY stop value. (E.g., "^DPT(25,")
|
|
; p(3) = # lines limit
|
|
; p(4) = Screen format (E.g., "^DPT(#,0)")
|
|
;
|
|
N LPVAL,NO,NOLINE,SCREEN,STOP
|
|
;
|
|
; Get values...
|
|
QUIT:'$$OKVARSQ(VAL) ;->
|
|
;
|
|
; Loop and collect now...
|
|
S NO=$O(^XTMP(XTMP,"HLQUERY",":"),-1)+1
|
|
S ^XTMP(XTMP,"HLQUERY",+NO)=VAL
|
|
;
|
|
; Add to list of items being queried...
|
|
S TXT=""
|
|
F PCE=1:1:$L(VAL,U) D
|
|
. S DATA=$P(VAL,U,PCE)
|
|
. I PCE=1!(PCE=2)!(PCE=4) S DATA=U_DATA
|
|
. I PCE=3 D
|
|
. . I DATA']"" S DATA="[1000]"
|
|
. . S DATA=" "_DATA
|
|
. S DATA="[#"_PCE_"]"_DATA
|
|
. I $L(DATA)>15 S DATA=$P(DATA,"]",2,99)
|
|
. S DATA=$S($L(DATA)>15:DATA_" ",1:$E(DATA_$$REPEAT^XLFSTR(" ",15),1,15))
|
|
. S TXT=TXT_$S(TXT]"":" ",1:"")_DATA
|
|
;
|
|
I TXT]"" D
|
|
. D ADDREQHD
|
|
. D ADDREQ(TXT)
|
|
;
|
|
Q
|
|
;
|
|
OKVARSQ(VAL) ; Are variables OK for $QUERY looping?
|
|
; Defines (and "leaves around") LPVAL,STOP,NOLINE,SCREEN...
|
|
S (LPVAL,NOLINE,SCREEN,STOP)=""
|
|
S LPVAL=U_$P(VAL,U) S X="W "_LPVAL D ^DIM QUIT:'$D(X) "" ;->
|
|
QUIT:$E(LPVAL,1,3)'="^HL"&($E(LPVAL,1,8)'="^ORD(101") "" ;->
|
|
S STOP=U_$P(VAL,U,2) S X="W "_STOP_"25)" D ^DIM QUIT:'$D(X) "" ;->
|
|
S X=$P(VAL,U,3),NOLINE=$S(X>1000:1000,X>0:X,1:1000)
|
|
S SCREEN=$P(VAL,U,4) I SCREEN]"" D QUIT:'$D(X) "" ;->
|
|
. S SCREEN=U_SCREEN
|
|
. S X="W "_$TR(SCREEN,"#",1) D ^DIM
|
|
QUIT 1
|
|
;
|
|
LOADQ(VAL) ; Load $QUERY format data...
|
|
N CT,LPVAL,NO,NOLINE,POSX,REF,SCREEN,STOP,TXT
|
|
;
|
|
; Already checked format. But, this call sets up looping variables...
|
|
QUIT:'$$OKVARSQ(VAL) ;->
|
|
;
|
|
S CT=0
|
|
F S LPVAL=$Q(@LPVAL) Q:$$QUITQ^HLEVSRV0(LPVAL,STOP,NOLINE,CT) D
|
|
. I SCREEN]"" QUIT:$$QUITS^HLEVSRV0(LPVAL,SCREEN) ;->
|
|
. S REF=LPVAL_"=",POSX=$L(REF)
|
|
. S DATA=@LPVAL,CT=CT+1
|
|
. F D QUIT:$TR(REF," ","")']""&(DATA']"")
|
|
. . S TXT=REF_$E(DATA,1,74-$L(REF))
|
|
. . D ADDMAIL(TXT)
|
|
. . S CT=CT+1
|
|
. . S DATA=$E(DATA,74-$L(REF)+1,999)
|
|
. . S REF=$$REPEAT^XLFSTR(" ",POSX)
|
|
;
|
|
I CT D ADDMAIL("")
|
|
;
|
|
Q
|
|
;
|
|
; =====================================================================
|
|
;
|
|
ADDREQHD ; Add Header to request record in email...
|
|
S ADDREQHD=$G(ADDREQHD)+1 QUIT:ADDREQHD>1 ;->
|
|
D ADDREQ(""),ADDREQ("Data Requests")
|
|
D ADDREQ($$REPEAT^XLFSTR("-",74))
|
|
Q
|
|
;
|
|
ADDLINE(XMRG) ; Add read line of text to ^TMP...
|
|
N LNO
|
|
S LNO=$O(^XTMP(XTMP,"RQ",":"),-1)+1
|
|
S ^XTMP(XTMP,"RQ",+LNO)=XMRG
|
|
Q
|
|
;
|
|
ADDREQ(TXT) ; Add data request to be added to ^XTMP(XTMP,"HLMAIL") later
|
|
N SNO
|
|
S SNO=$O(^XTMP(XTMP,"HLREQ",":"),-1)+1
|
|
S ^XTMP(XTMP,"HLREQ",+SNO)=TXT
|
|
Q
|
|
;
|
|
ADDMAIL(TXT) D ADDMAIL^HLEVSRV2(TXT)
|
|
Q
|
|
;
|
|
OKFILE(FILE) QUIT:+FILE=101 1 ;->
|
|
I FILE>769.99999&(FILE<870) QUIT 1 ;->
|
|
Q ""
|
|
;
|
|
EOR ;HLEVSRV - Event Monitor SERVER ;5/16/03 14:42
|