HLEVSRV0 ;O-OIFO/LJA - Event Monitor SERVER ;02/04/2004 14:42
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
M(TXT) ; Called when M code data requested in...
; MXEC,XTMP -- req
N MCODE,NO,MTAG,WHEN
;
; Sets...
S WHEN=$P(TXT,U)
;
; Has license been sent?
I WHEN="LICENSE" D QUIT ;->
. QUIT:$P(MXEC,U,4)]"" ;->
. S MCODE=$P(TXT,U,2)
. I '$$OKCODE^HLEVSRV1(MCODE) S $P(MXEC,U,4)=0 QUIT ;->
. S $P(MXEC,U,4)=1 ; Force DOWN...
;
QUIT:WHEN'="BEFORE"&(WHEN'="AFTER") ;->
S MTAG=$P(TXT,U,2) QUIT:MTAG']"" ;->
S MCODE=$P(TXT,U,3,999) Q:MCODE']"" ;->
;
; Is it valid M code?
S X=MCODE D ^DIM QUIT:'$D(X) ;->
;
S NO=$O(^XTMP(XTMP,"M",WHEN,MTAG,":"),-1)+1
S ^XTMP(XTMP,"M",WHEN,MTAG,+NO)=MCODE
;
Q
;
MPRE ; Run M code before load of data...
; XTMP -- req
D MRUN("BEFORE")
Q
;
MPST ; Run M code after load of data...
; XTMP -- req
D MRUN("AFTER")
Q
;
MRUN(WHEN) ; Run M code's INIT...
; XTMP -- req
N ZZADD,ZZCALL,ZZMCODE,ZZMLNO,ZZMTAG,ZZNEXT,ZZNO,ZZREC
;
; Get starting M code...
QUIT:$G(^XTMP(XTMP,"M",WHEN,"INIT",1))']"" ;->
;
; Values set up as a service for the developer sending in M code...
;
; NEXT LINE - Executable code to execute next line in "subroutine"...
S ZZNEXT="S ZZMLNO=ZZMLNO+1,ZZMCODE=$G(^XTMP(XTMP,""M"",WHEN,ZZMTAG,ZZMLNO)) QUIT:ZZMCODE']"""" X ZZMCODE,ZZREC"
S ZZREC="S ZZCALL=$G(ZZCALL)+1,^XTMP(XTMP,""M"",""REC"",WHEN,ZZCALL)=ZZMLNO_U_ZZMTAG"
S ZZADD="D ADDMTXT^HLEVSRV0($G(ZZTXT))"
;
; Set up every "subroutine" in an executable call "tag"
S ZZMCODE=""
F S ZZMCODE=$O(^XTMP(XTMP,"M",WHEN,ZZMCODE)) Q:ZZMCODE']"" D
. S @ZZMCODE="S ZZMTAG="""_ZZMCODE_""",ZZMLNO=0 X ZZNEXT"
;
S ZZCALL=0
;
; Start...
X INIT
;
Q
;
MCOND ; Condense M call data...
N DATA,TAG,TAGL,TAGN,TXT,WHEN,ZZCALL
;
QUIT:'$D(^XTMP(XTMP,"M","REC")) ;->
;
KILL ^TMP($J,"HLMCOND")
;
F WHEN="BEFORE","AFTER" D
. S ZZCALL=0,TXT=WHEN_": ",POSX=$L(TXT),TAGL="",TAGN=0
. F S ZZCALL=$O(^XTMP(XTMP,"M","REC",WHEN,ZZCALL)) Q:ZZCALL'>0 D
. . S DATA=^XTMP(XTMP,"M","REC",WHEN,ZZCALL),TAG=$P(DATA,U,2) QUIT:TAG']"" ;->
. . I $L(TXT)>55 D
. . . D ADD(TXT)
. . . S TXT=$$REPEAT^XLFSTR(" ",POSX)
. . I TAGL'=TAG D
. . . I TAGL]"",TAGN>0 S TXT=TXT_"(#"_TAGN_")",TAGN=0
. . . S TXT=TXT_$S($L(TXT)>POSX:"-",1:"")_TAG,TAGN=1
. . I TAGL=TAG S TAGN=TAGN+1
. . S TAGL=TAG
. I TAGN>0,$L(TXT)>POSX S TXT=TXT_"(#"_TAGN_")",TAGN=0
. I $L(TXT)>POSX D ADD(TXT)
;
QUIT:'$D(^TMP($J,"HLMCOND")) ;->
;
KILL ^XTMP(XTMP,"M","REC")
MERGE ^XTMP(XTMP,"M","REC")=^TMP($J,"HLMCOND")
;
Q
;
MCALLREC ; Store MCOND data in mail message..
N NO
;
QUIT:'$D(^XTMP(XTMP,"M","REC")) ;->
;
D ADDMAIL^HLEVSRV(""),ADDMAIL^HLEVSRV("M Call Record")
D ADDMAIL^HLEVSRV($$REPEAT^XLFSTR("-",74))
;
S NO=0
F S NO=$O(^XTMP(XTMP,"M","REC",NO)) Q:NO'>0 D
. D ADDMAIL^HLEVSRV(^XTMP(XTMP,"M","REC",NO))
;
Q
;
ADDMTXT(TXT) ;
N NO
S NO=$O(^XTMP(XTMP,"MTEXT",":"),-1)+1
S ^XTMP(XTMP,"MTEXT",+NO)=TXT
Q
;
MTEXT ; Add text to Mailman message created by M code...
N NO
;
I $G(^XTMP(XTMP,"MTEXT")) D
. D ADDMAIL("")
. D ADDMAIL($$CJ^XLFSTR(" M-Created Text ",74,"-"))
;
S NO=0
F S NO=$O(^XTMP(XTMP,"MTEXT",NO)) Q:NO'>0 D
. D ADDMAIL(^XTMP(XTMP,"MTEXT",NO))
;
Q
;
ADD(TXT) ;
N NO
S NO=$O(^TMP($J,"HLMCOND",":"),-1)+1
S ^TMP($J,"HLMCOND",+NO)=TXT
Q
;
MTEST ; Test M code embedded in a Mailman message...
N IOINHI,IOINORM,MIEN,X,XTMP
;
S X="IOINHI;IOINORM" D ENDR^%ZISS
;
W @IOF,$$CJ^XLFSTR("M Code Test",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
W !!,"This utility will execute the code in the BEFORE and AFTER sections of the"
W !,"M code embedded in a Mailman message. The message must be in the format"
W !,"used by the [HLEV-INFORMATION-SERVER] menu option."
;
MT1 W !
F R !,"Message IEN: ",MIEN:60 Q:MIEN'>0 D QUIT:$G(^XMB(3.9,+MIEN,0))]""
. I $G(^XMB(3.9,+MIEN,0))']"" D QUIT ;->
. . W " no message found..."
. W " ",$P(^XMB(3.9,+MIEN,0),U),"..."
;
QUIT:$G(^XMB(3.9,+MIEN,0))']"" ;->
;
S XTMP="HLEV SERVER 9999999",NOW=$$NOW^XLFDT
KILL ^XTMP(XTMP)
S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,1)_U_NOW_U_"TEST"
;
W !!,"Loading M code..."
S LNO=0
F S LNO=$O(^XMB(3.9,+MIEN,2,LNO)) Q:LNO'>0 D
. S TXT=$G(^XMB(3.9,+MIEN,2,+LNO,0)) QUIT:$E(TXT,1,2)'="M^" ;->
. S TXT=$P(TXT,U,2,999) QUIT:TXT']"" ;->
. W "."
. D M(TXT)
;
I '$D(^XTMP(XTMP,"M")) D G MT1 ;->
. W !!,"No M code embedded in this Mailman message..."
;
W !
S LP=$NA(^XTMP(XTMP,"M")),ST="^XTMP("""_XTMP_""",""M"","
F S LP=$Q(@LP) Q:LP'[ST D
. W !,IOINHI,"...",$P(LP,",""M"",",2,99),IOINORM," = "
. S POSX=$X,DATA=@LP
. F QUIT:DATA']"" D
. . W $E(DATA,1,IOM-POSX)
. . S DATA=$E(DATA,IOM-POSX+1,999)
;
W !!,"You can execute the BEFORE load M code, or the AFTER load M code. The BEFORE"
W !,"load M code requires a BEFORE^INIT... node(s). The AFTER load M code"
W !,"requires an AFTER^INIT... node(s)."
;
I '$D(^XTMP(XTMP,"M","BEFORE"))&('$D(^XTMP(XTMP,"M","AFTER"))) D G MT1 ;->
. W !!,"You must add a BEFORE and/or AFTER section to the M code embedded in the"
. W !,"Mailman message before you can use this utility to test."
;
D MEX("BEFORE")
D MEX("AFTER")
;
KILL ^XTMP(XTMP)
;
W !!,"Done..."
;
Q
;
MEX(WHEN) ; Called by MTEST to execute ^XTMP(XTMP,"M") code...
N X
QUIT:'$D(^XTMP(XTMP,"M",WHEN)) ;->
W !!,"Press RETURN to execute the ",IOINHI,WHEN,IOINORM
W " code, or '^' to skip... "
R X:60 I '$T!(X[U) W " no action taken..." QUIT ;->
W !,"Executing the ",WHEN," code..."
I WHEN="BEFORE" D MPRE
I WHEN="AFTER" D MPST
W " M code finished..."
Q
;
UNIT(TXT) ; Load IEN list found by MSG ID... (TXT=MsgID)
; XTMP -- req
;
; Data request line must equal UNIT^#^TYPE (#^TYPE passed in here)
;
; TYPE = "IEN772", "IEN773", or "MSGID"
; # = IEN772, IEN773 or MSGID
;
; The # used to find any IEN772 in the unit.
; All messages in unit found using $$LOAD772S^HLUCM009, and
; formatted by LOADUNIT and returned in email to user.
;
N CT,HL772,HLID,HLTYPE,IEN772,IEN773,IEN773,NO772S
;
; Initial sets...
S HLID=$P($G(TXT),U) QUIT:HLID']"" ;->
S HLTYPE=$P(TXT,U,2) ; IEN772, IEN773, or MSGID
S IEN772=""
;
; Try to get IEN772 from MSGID...
I HLTYPE="MSGID" D QUIT:'IEN772 ;->
. S IEN772=$O(^HL(772,"C",HLID,":"),-1)
. I IEN772 D QUIT:IEN772'>0 ;->
. . S IEN773=$O(^HLMA("C",HLID,0)) QUIT:IEN773'>0 ;->
. . S IEN772=+$G(^HLMA(+IEN773,0))
. S IEN773=$O(^HLMA("C",HLID,":"),-1) QUIT:'IEN773 ;->
. S IEN772=+$G(^HLMA(+IEN773,0))
;
; If passed IEN772...
I HLTYPE="IEN772" D QUIT:IEN772'>0 ;->
. QUIT:$G(^HL(772,+HLID,0))']"" ;->
. S IEN772=+HLID
;
; If passed IEN773...
I HLTYPE="IEN773" D QUIT:IEN772'>0 ;->
. S IEN772=+$G(^HLMA(+HLID,0))
. QUIT:$G(^HL(772,+IEN772,0))]"" ;-> It's OK
. S IEN772=""
;
QUIT:$G(^HL(772,+$G(IEN772),0))']"" ;->
;
; Load associated entries...
S NO772S=$$LOAD772S^HLUCM009(+IEN772,.HL772) QUIT:NO772S'>0 ;->
;
; Load data...
S IEN772=0
F S IEN772=$O(HL772("HLPARENT",IEN772)) Q:IEN772'>0 D
. S IEN772C=0
. F S IEN772C=$O(HL772("HLPARENT",IEN772,IEN772C)) Q:IEN772C'>0 D
. . S ^XTMP(XTMP,"HLUNIT",IEN772,IEN772C)=""
;
Q
;
LOADUNIT ; Load data found by UNIT above...
N IEN772C,IEN772P,POSX,TXT
;
QUIT:'$D(^XTMP(XTMP,"HLUNIT")) ;->
;
D ADDMAIL(""),ADDMAIL($$CJ^XLFSTR(" Msg ID-requested Message Units ",74,"-"))
;
S IEN772P=0
F S IEN772P=$O(^XTMP(XTMP,"HLUNIT",IEN772P)) Q:IEN772P'>0 D
. S TXT=IEN772P_": ",POSX=$L(TXT)
. S IEN772C=0
. F S IEN772C=$O(^XTMP(XTMP,"HLUNIT",IEN772P,IEN772C)) Q:IEN772C'>0 D
. . I ($L(TXT)+$L(IEN772C)+2)>74 D
. . . D ADDMAIL(TXT)
. . . S TXT=$$REPEAT^XLFSTR(" ",POSX)
. . S TXT=TXT_$S($L(TXT)>POSX:",",1:"")_IEN772C
. I TXT]"" D ADDMAIL(TXT) S TXT=""
;
Q
;
ADDMAIL(TXT) D ADDMAIL^HLEVSRV(TXT)
Q
;
QUITQ(LPVAL,STOP,NOLINE,CT) ; Should looping stop?
QUIT:LPVAL']"" 1 ;->
QUIT:LPVAL'[STOP 1 ;->
QUIT:(CT+1)>NOLINE 1 ;->
Q ""
;
QUITS(LPVAL,SCREEN) ; Should this be included?
N DATA,DIV,MAXNO,OK,PCE,VAL,X
S DIV=""
S MAXNO=$L(LPVAL,",") I $L(SCREEN,",")'=MAXNO QUIT 1 ;->
F PCE=1:1:MAXNO D QUIT:'OK
. S OK=0
. S X=$P(SCREEN,"#",PCE),DIV=$S(DIV]"":",",1:$E(X,$L(X)))
. S DATA(1)=$P(LPVAL,DIV,+PCE) QUIT:DATA(1)']"" ;->
. S DATA(2)=$P(SCREEN,DIV,+PCE) QUIT:DATA(2)']"" ;->
. I DATA(2)="#" QUIT:DATA(1)'?1.N ;->
. I DATA(2)'="#" QUIT:DATA(1)'=DATA(2) ;->
. S OK=1
S OK='OK ; Because this is a QUIT IF extrinsic function
Q OK
;
ADDLINE(TXT) D ADDLINE^HLEVSRV(TXT)
Q
;
EOR ;HLEVSRV0 - Event Monitor SERVER ;5/16/03 14:42
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVSRV0 8868 printed Sep 23, 2025@19:33:59 Page 2
HLEVSRV0 ;O-OIFO/LJA - Event Monitor SERVER ;02/04/2004 14:42
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
M(TXT) ; Called when M code data requested in...
+1 ; MXEC,XTMP -- req
+2 NEW MCODE,NO,MTAG,WHEN
+3 ;
+4 ; Sets...
+5 SET WHEN=$PIECE(TXT,U)
+6 ;
+7 ; Has license been sent?
+8 ;->
IF WHEN="LICENSE"
Begin DoDot:1
+9 ;->
if $PIECE(MXEC,U,4)]""
QUIT
+10 SET MCODE=$PIECE(TXT,U,2)
+11 ;->
IF '$$OKCODE^HLEVSRV1(MCODE)
SET $PIECE(MXEC,U,4)=0
QUIT
+12 ; Force DOWN...
SET $PIECE(MXEC,U,4)=1
End DoDot:1
QUIT
+13 ;
+14 ;->
if WHEN'="BEFORE"&(WHEN'="AFTER")
QUIT
+15 ;->
SET MTAG=$PIECE(TXT,U,2)
if MTAG']""
QUIT
+16 ;->
SET MCODE=$PIECE(TXT,U,3,999)
if MCODE']""
QUIT
+17 ;
+18 ; Is it valid M code?
+19 ;->
SET X=MCODE
DO ^DIM
if '$DATA(X)
QUIT
+20 ;
+21 SET NO=$ORDER(^XTMP(XTMP,"M",WHEN,MTAG,":"),-1)+1
+22 SET ^XTMP(XTMP,"M",WHEN,MTAG,+NO)=MCODE
+23 ;
+24 QUIT
+25 ;
MPRE ; Run M code before load of data...
+1 ; XTMP -- req
+2 DO MRUN("BEFORE")
+3 QUIT
+4 ;
MPST ; Run M code after load of data...
+1 ; XTMP -- req
+2 DO MRUN("AFTER")
+3 QUIT
+4 ;
MRUN(WHEN) ; Run M code's INIT...
+1 ; XTMP -- req
+2 NEW ZZADD,ZZCALL,ZZMCODE,ZZMLNO,ZZMTAG,ZZNEXT,ZZNO,ZZREC
+3 ;
+4 ; Get starting M code...
+5 ;->
if $GET(^XTMP(XTMP,"M",WHEN,"INIT",1))']""
QUIT
+6 ;
+7 ; Values set up as a service for the developer sending in M code...
+8 ;
+9 ; NEXT LINE - Executable code to execute next line in "subroutine"...
+10 SET ZZNEXT="S ZZMLNO=ZZMLNO+1,ZZMCODE=$G(^XTMP(XTMP,""M"",WHEN,ZZMTAG,ZZMLNO)) QUIT:ZZMCODE']"""" X ZZMCODE,ZZREC"
+11 SET ZZREC="S ZZCALL=$G(ZZCALL)+1,^XTMP(XTMP,""M"",""REC"",WHEN,ZZCALL)=ZZMLNO_U_ZZMTAG"
+12 SET ZZADD="D ADDMTXT^HLEVSRV0($G(ZZTXT))"
+13 ;
+14 ; Set up every "subroutine" in an executable call "tag"
+15 SET ZZMCODE=""
+16 FOR
SET ZZMCODE=$ORDER(^XTMP(XTMP,"M",WHEN,ZZMCODE))
if ZZMCODE']""
QUIT
Begin DoDot:1
+17 SET @ZZMCODE="S ZZMTAG="""_ZZMCODE_""",ZZMLNO=0 X ZZNEXT"
End DoDot:1
+18 ;
+19 SET ZZCALL=0
+20 ;
+21 ; Start...
+22 XECUTE INIT
+23 ;
+24 QUIT
+25 ;
MCOND ; Condense M call data...
+1 NEW DATA,TAG,TAGL,TAGN,TXT,WHEN,ZZCALL
+2 ;
+3 ;->
if '$DATA(^XTMP(XTMP,"M","REC"))
QUIT
+4 ;
+5 KILL ^TMP($JOB,"HLMCOND")
+6 ;
+7 FOR WHEN="BEFORE","AFTER"
Begin DoDot:1
+8 SET ZZCALL=0
SET TXT=WHEN_": "
SET POSX=$LENGTH(TXT)
SET TAGL=""
SET TAGN=0
+9 FOR
SET ZZCALL=$ORDER(^XTMP(XTMP,"M","REC",WHEN,ZZCALL))
if ZZCALL'>0
QUIT
Begin DoDot:2
+10 ;->
SET DATA=^XTMP(XTMP,"M","REC",WHEN,ZZCALL)
SET TAG=$PIECE(DATA,U,2)
if TAG']""
QUIT
+11 IF $LENGTH(TXT)>55
Begin DoDot:3
+12 DO ADD(TXT)
+13 SET TXT=$$REPEAT^XLFSTR(" ",POSX)
End DoDot:3
+14 IF TAGL'=TAG
Begin DoDot:3
+15 IF TAGL]""
IF TAGN>0
SET TXT=TXT_"(#"_TAGN_")"
SET TAGN=0
+16 SET TXT=TXT_$SELECT($LENGTH(TXT)>POSX:"-",1:"")_TAG
SET TAGN=1
End DoDot:3
+17 IF TAGL=TAG
SET TAGN=TAGN+1
+18 SET TAGL=TAG
End DoDot:2
+19 IF TAGN>0
IF $LENGTH(TXT)>POSX
SET TXT=TXT_"(#"_TAGN_")"
SET TAGN=0
+20 IF $LENGTH(TXT)>POSX
DO ADD(TXT)
End DoDot:1
+21 ;
+22 ;->
if '$DATA(^TMP($JOB,"HLMCOND"))
QUIT
+23 ;
+24 KILL ^XTMP(XTMP,"M","REC")
+25 MERGE ^XTMP(XTMP,"M","REC")=^TMP($JOB,"HLMCOND")
+26 ;
+27 QUIT
+28 ;
MCALLREC ; Store MCOND data in mail message..
+1 NEW NO
+2 ;
+3 ;->
if '$DATA(^XTMP(XTMP,"M","REC"))
QUIT
+4 ;
+5 DO ADDMAIL^HLEVSRV("")
DO ADDMAIL^HLEVSRV("M Call Record")
+6 DO ADDMAIL^HLEVSRV($$REPEAT^XLFSTR("-",74))
+7 ;
+8 SET NO=0
+9 FOR
SET NO=$ORDER(^XTMP(XTMP,"M","REC",NO))
if NO'>0
QUIT
Begin DoDot:1
+10 DO ADDMAIL^HLEVSRV(^XTMP(XTMP,"M","REC",NO))
End DoDot:1
+11 ;
+12 QUIT
+13 ;
ADDMTXT(TXT) ;
+1 NEW NO
+2 SET NO=$ORDER(^XTMP(XTMP,"MTEXT",":"),-1)+1
+3 SET ^XTMP(XTMP,"MTEXT",+NO)=TXT
+4 QUIT
+5 ;
MTEXT ; Add text to Mailman message created by M code...
+1 NEW NO
+2 ;
+3 IF $GET(^XTMP(XTMP,"MTEXT"))
Begin DoDot:1
+4 DO ADDMAIL("")
+5 DO ADDMAIL($$CJ^XLFSTR(" M-Created Text ",74,"-"))
End DoDot:1
+6 ;
+7 SET NO=0
+8 FOR
SET NO=$ORDER(^XTMP(XTMP,"MTEXT",NO))
if NO'>0
QUIT
Begin DoDot:1
+9 DO ADDMAIL(^XTMP(XTMP,"MTEXT",NO))
End DoDot:1
+10 ;
+11 QUIT
+12 ;
ADD(TXT) ;
+1 NEW NO
+2 SET NO=$ORDER(^TMP($JOB,"HLMCOND",":"),-1)+1
+3 SET ^TMP($JOB,"HLMCOND",+NO)=TXT
+4 QUIT
+5 ;
MTEST ; Test M code embedded in a Mailman message...
+1 NEW IOINHI,IOINORM,MIEN,X,XTMP
+2 ;
+3 SET X="IOINHI;IOINORM"
DO ENDR^%ZISS
+4 ;
+5 WRITE @IOF,$$CJ^XLFSTR("M Code Test",IOM)
+6 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+7 WRITE !!,"This utility will execute the code in the BEFORE and AFTER sections of the"
+8 WRITE !,"M code embedded in a Mailman message. The message must be in the format"
+9 WRITE !,"used by the [HLEV-INFORMATION-SERVER] menu option."
+10 ;
MT1 WRITE !
+1 FOR
READ !,"Message IEN: ",MIEN:60
if MIEN'>0
QUIT
Begin DoDot:1
+2 ;->
IF $GET(^XMB(3.9,+MIEN,0))']""
Begin DoDot:2
+3 WRITE " no message found..."
End DoDot:2
QUIT
+4 WRITE " ",$PIECE(^XMB(3.9,+MIEN,0),U),"..."
End DoDot:1
if $GET(^XMB(3.9,+MIEN,0))]""
QUIT
+5 ;
+6 ;->
if $GET(^XMB(3.9,+MIEN,0))']""
QUIT
+7 ;
+8 SET XTMP="HLEV SERVER 9999999"
SET NOW=$$NOW^XLFDT
+9 KILL ^XTMP(XTMP)
+10 SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,1)_U_NOW_U_"TEST"
+11 ;
+12 WRITE !!,"Loading M code..."
+13 SET LNO=0
+14 FOR
SET LNO=$ORDER(^XMB(3.9,+MIEN,2,LNO))
if LNO'>0
QUIT
Begin DoDot:1
+15 ;->
SET TXT=$GET(^XMB(3.9,+MIEN,2,+LNO,0))
if $EXTRACT(TXT,1,2)'="M^"
QUIT
+16 ;->
SET TXT=$PIECE(TXT,U,2,999)
if TXT']""
QUIT
+17 WRITE "."
+18 DO M(TXT)
End DoDot:1
+19 ;
+20 ;->
IF '$DATA(^XTMP(XTMP,"M"))
Begin DoDot:1
+21 WRITE !!,"No M code embedded in this Mailman message..."
End DoDot:1
GOTO MT1
+22 ;
+23 WRITE !
+24 SET LP=$NAME(^XTMP(XTMP,"M"))
SET ST="^XTMP("""_XTMP_""",""M"","
+25 FOR
SET LP=$QUERY(@LP)
if LP'[ST
QUIT
Begin DoDot:1
+26 WRITE !,IOINHI,"...",$PIECE(LP,",""M"",",2,99),IOINORM," = "
+27 SET POSX=$X
SET DATA=@LP
+28 FOR
if DATA']""
QUIT
Begin DoDot:2
+29 WRITE $EXTRACT(DATA,1,IOM-POSX)
+30 SET DATA=$EXTRACT(DATA,IOM-POSX+1,999)
End DoDot:2
End DoDot:1
+31 ;
+32 WRITE !!,"You can execute the BEFORE load M code, or the AFTER load M code. The BEFORE"
+33 WRITE !,"load M code requires a BEFORE^INIT... node(s). The AFTER load M code"
+34 WRITE !,"requires an AFTER^INIT... node(s)."
+35 ;
+36 ;->
IF '$DATA(^XTMP(XTMP,"M","BEFORE"))&('$DATA(^XTMP(XTMP,"M","AFTER")))
Begin DoDot:1
+37 WRITE !!,"You must add a BEFORE and/or AFTER section to the M code embedded in the"
+38 WRITE !,"Mailman message before you can use this utility to test."
End DoDot:1
GOTO MT1
+39 ;
+40 DO MEX("BEFORE")
+41 DO MEX("AFTER")
+42 ;
+43 KILL ^XTMP(XTMP)
+44 ;
+45 WRITE !!,"Done..."
+46 ;
+47 QUIT
+48 ;
MEX(WHEN) ; Called by MTEST to execute ^XTMP(XTMP,"M") code...
+1 NEW X
+2 ;->
if '$DATA(^XTMP(XTMP,"M",WHEN))
QUIT
+3 WRITE !!,"Press RETURN to execute the ",IOINHI,WHEN,IOINORM
+4 WRITE " code, or '^' to skip... "
+5 ;->
READ X:60
IF '$TEST!(X[U)
WRITE " no action taken..."
QUIT
+6 WRITE !,"Executing the ",WHEN," code..."
+7 IF WHEN="BEFORE"
DO MPRE
+8 IF WHEN="AFTER"
DO MPST
+9 WRITE " M code finished..."
+10 QUIT
+11 ;
UNIT(TXT) ; Load IEN list found by MSG ID... (TXT=MsgID)
+1 ; XTMP -- req
+2 ;
+3 ; Data request line must equal UNIT^#^TYPE (#^TYPE passed in here)
+4 ;
+5 ; TYPE = "IEN772", "IEN773", or "MSGID"
+6 ; # = IEN772, IEN773 or MSGID
+7 ;
+8 ; The # used to find any IEN772 in the unit.
+9 ; All messages in unit found using $$LOAD772S^HLUCM009, and
+10 ; formatted by LOADUNIT and returned in email to user.
+11 ;
+12 NEW CT,HL772,HLID,HLTYPE,IEN772,IEN773,IEN773,NO772S
+13 ;
+14 ; Initial sets...
+15 ;->
SET HLID=$PIECE($GET(TXT),U)
if HLID']""
QUIT
+16 ; IEN772, IEN773, or MSGID
SET HLTYPE=$PIECE(TXT,U,2)
+17 SET IEN772=""
+18 ;
+19 ; Try to get IEN772 from MSGID...
+20 ;->
IF HLTYPE="MSGID"
Begin DoDot:1
+21 SET IEN772=$ORDER(^HL(772,"C",HLID,":"),-1)
+22 ;->
IF IEN772
Begin DoDot:2
+23 ;->
SET IEN773=$ORDER(^HLMA("C",HLID,0))
if IEN773'>0
QUIT
+24 SET IEN772=+$GET(^HLMA(+IEN773,0))
End DoDot:2
if IEN772'>0
QUIT
+25 ;->
SET IEN773=$ORDER(^HLMA("C",HLID,":"),-1)
if 'IEN773
QUIT
+26 SET IEN772=+$GET(^HLMA(+IEN773,0))
End DoDot:1
if 'IEN772
QUIT
+27 ;
+28 ; If passed IEN772...
+29 ;->
IF HLTYPE="IEN772"
Begin DoDot:1
+30 ;->
if $GET(^HL(772,+HLID,0))']""
QUIT
+31 SET IEN772=+HLID
End DoDot:1
if IEN772'>0
QUIT
+32 ;
+33 ; If passed IEN773...
+34 ;->
IF HLTYPE="IEN773"
Begin DoDot:1
+35 SET IEN772=+$GET(^HLMA(+HLID,0))
+36 ;-> It's OK
if $GET(^HL(772,+IEN772,0))]""
QUIT
+37 SET IEN772=""
End DoDot:1
if IEN772'>0
QUIT
+38 ;
+39 ;->
if $GET(^HL(772,+$GET(IEN772),0))']""
QUIT
+40 ;
+41 ; Load associated entries...
+42 ;->
SET NO772S=$$LOAD772S^HLUCM009(+IEN772,.HL772)
if NO772S'>0
QUIT
+43 ;
+44 ; Load data...
+45 SET IEN772=0
+46 FOR
SET IEN772=$ORDER(HL772("HLPARENT",IEN772))
if IEN772'>0
QUIT
Begin DoDot:1
+47 SET IEN772C=0
+48 FOR
SET IEN772C=$ORDER(HL772("HLPARENT",IEN772,IEN772C))
if IEN772C'>0
QUIT
Begin DoDot:2
+49 SET ^XTMP(XTMP,"HLUNIT",IEN772,IEN772C)=""
End DoDot:2
End DoDot:1
+50 ;
+51 QUIT
+52 ;
LOADUNIT ; Load data found by UNIT above...
+1 NEW IEN772C,IEN772P,POSX,TXT
+2 ;
+3 ;->
if '$DATA(^XTMP(XTMP,"HLUNIT"))
QUIT
+4 ;
+5 DO ADDMAIL("")
DO ADDMAIL($$CJ^XLFSTR(" Msg ID-requested Message Units ",74,"-"))
+6 ;
+7 SET IEN772P=0
+8 FOR
SET IEN772P=$ORDER(^XTMP(XTMP,"HLUNIT",IEN772P))
if IEN772P'>0
QUIT
Begin DoDot:1
+9 SET TXT=IEN772P_": "
SET POSX=$LENGTH(TXT)
+10 SET IEN772C=0
+11 FOR
SET IEN772C=$ORDER(^XTMP(XTMP,"HLUNIT",IEN772P,IEN772C))
if IEN772C'>0
QUIT
Begin DoDot:2
+12 IF ($LENGTH(TXT)+$LENGTH(IEN772C)+2)>74
Begin DoDot:3
+13 DO ADDMAIL(TXT)
+14 SET TXT=$$REPEAT^XLFSTR(" ",POSX)
End DoDot:3
+15 SET TXT=TXT_$SELECT($LENGTH(TXT)>POSX:",",1:"")_IEN772C
End DoDot:2
+16 IF TXT]""
DO ADDMAIL(TXT)
SET TXT=""
End DoDot:1
+17 ;
+18 QUIT
+19 ;
ADDMAIL(TXT) DO ADDMAIL^HLEVSRV(TXT)
+1 QUIT
+2 ;
QUITQ(LPVAL,STOP,NOLINE,CT) ; Should looping stop?
+1 ;->
if LPVAL']""
QUIT 1
+2 ;->
if LPVAL'[STOP
QUIT 1
+3 ;->
if (CT+1)>NOLINE
QUIT 1
+4 QUIT ""
+5 ;
QUITS(LPVAL,SCREEN) ; Should this be included?
+1 NEW DATA,DIV,MAXNO,OK,PCE,VAL,X
+2 SET DIV=""
+3 ;->
SET MAXNO=$LENGTH(LPVAL,",")
IF $LENGTH(SCREEN,",")'=MAXNO
QUIT 1
+4 FOR PCE=1:1:MAXNO
Begin DoDot:1
+5 SET OK=0
+6 SET X=$PIECE(SCREEN,"#",PCE)
SET DIV=$SELECT(DIV]"":",",1:$EXTRACT(X,$LENGTH(X)))
+7 ;->
SET DATA(1)=$PIECE(LPVAL,DIV,+PCE)
if DATA(1)']""
QUIT
+8 ;->
SET DATA(2)=$PIECE(SCREEN,DIV,+PCE)
if DATA(2)']""
QUIT
+9 ;->
IF DATA(2)="#"
if DATA(1)'?1.N
QUIT
+10 ;->
IF DATA(2)'="#"
if DATA(1)'=DATA(2)
QUIT
+11 SET OK=1
End DoDot:1
if 'OK
QUIT
+12 ; Because this is a QUIT IF extrinsic function
SET OK='OK
+13 QUIT OK
+14 ;
ADDLINE(TXT) DO ADDLINE^HLEVSRV(TXT)
+1 QUIT
+2 ;
EOR ;HLEVSRV0 - Event Monitor SERVER ;5/16/03 14:42
