- 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 Jan 18, 2025@02:59:08 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