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

HLEVSRV.m

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