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