HLEVUTI1 ;OIFO-O/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;;
;
; Utility to aid in displaying 870 data...
;
CTRL ;
N ABRT,CT,CONT,DATA,DATE,DIC,GBL,HD,IOINHI,IOINORM,L870,LAST
N LNM,LNO,LNS,N,NO,NODE,TOT,TXT,WAY,WHAT,X,Y
;
S X="IOINHI;IOINORM" D ENDR^%ZISS
CTRL0 W @IOF,$$CJ^XLFSTR("Logical Link Display",IOM),!,$$REPEAT^XLFSTR("=",IOM)
D QUEUES
W ! S L870=$$LINK Q:'L870
S GBL="^HLCS(870,"_L870_")"
S LNM=$$LNM(L870)
W " ",LNM
CTRL1 D SHOWHD(LNM,L870)
W !!,"What information for IN and OUT QUEUEs do you want to see?"
W !!,"1 Show IENs",!,"2 Show Summary nodes",!,"3 Totals",!,"4 Dots",!,"5 Find skips",!,"6 Message date search"
R !!,"Enter #: ",WHAT:99 G:WHAT<1!(WHAT>6) CTRL0 ;->
W !!,$$CJ^XLFSTR(" "_IOINHI_LNM_IOINORM_" ",IOM+$L(IOINHI)+$L(IOINORM),"=")
S ABRT=0,CONT=0,CT=0
S WAY=$$ASKWAY QUIT:WAY[U ;->
S NO=$$ASKNO(LNM,L870,WAY) QUIT:NO[U ;->
I WHAT=6 D SEARCH(L870,WAY,NO) G CTRL1 ;->
S TOT(WAY)=0,LAST=""
QUIT:$O(@GBL@(WAY,0))'>0 ;->
W !,$$CJ^XLFSTR(" "_$S(WAY=1:"IN",1:"OUT")_" QUEUE ",IOM,"-")
I WHAT=3 W !,"Totaling..."
F S NO=$O(@GBL@(WAY,NO)) Q:'NO!ABRT D
. S CT=CT+1
. S NODE=$G(@GBL@(WAY,NO,0)),DATE=$P($G(@GBL@(WAY,NO,1,0)),U,5)
. S TXT=$G(@GBL@(WAY,NO,1,1,0))
. S TXT=$E(DATE_" ",1,10)_$E(NODE_" ",1,12)_" "_$E(TXT,1,56)
. I WHAT=1 W:($X+$L(NO)+1)>IOM ! W:$X>0 "," W NO
. I WHAT=2 D
. . W !,TXT
. I WHAT=3 W:'(CT#5000) "." S TOT(WAY)=TOT(WAY)+1
. I WHAT=4 Q:$$CT W "."
. I WHAT=5 D
. . I LAST,+LAST'=(NO-1) D
. . . W !,+LAST,?10," ",$E($P(LAST,"~",2,999),1,IOM-$X)
. . . W !,+NO,?10," ",$E(TXT,1,69)
. . S LAST=NO_"~"_TXT
. I 'CONT,'(CT#20) R X:999 S:X[U ABRT=1 S:X=" " CONT=1
I 'ABRT,TOT(WAY) W !,"--- Total = #",TOT(WAY)
S ABRT="",CT=0
;
R !,"End of output... ",X:999
;
W !!,$$CJ^XLFSTR(" "_LNM_" ",IOM,"=")
;
G CTRL1 ;->
;
SHOWHD(LNM,L870) ; Show summary information...
N NODE
W !!,$$REPEAT^XLFSTR("=",IOM)
F NODE=0,100,200,300,400,"IN QUEUE BACK POINTER","IN QUEUE FRONT POINTER","OUT QUEUE BACK POINTER","OUT QUEUE FRONT POINTER" D
. S DATA=$G(@GBL@(NODE)) Q:DATA']"" ;->
. D PHD(NODE,DATA)
W !,$$REPEAT^XLFSTR("=",IOM)
Q
;
CT() QUIT:(CT#500) ""
R X:999 Q:X']"" ""
S ABRT=1
Q 1
;
PHD(HD,DATA) ;
S HD=$$HD(HD)
S HD=$E(" ",1,4-$L(HD))_HD
W !,HD,"="
F D QUIT:DATA']""
. QUIT:DATA']""
. W $E(DATA,1,76)
. S DATA=$E(DATA,77,999)
. W:DATA]"" !,?4
Q
;
HD(HD) ;
I HD["IN QUEUE F" S HD="IQFP"
I HD["IN QUEUE B" S HD="IQBP"
I HD["OUT QUEUE F" S HD="OQFP"
I HD["OUT QUEUE B" S HD="OQBP"
Q HD
;
LINK() N DIC,X,Y
S DIC=870,DIC(0)="AEMQN",DIC("A")="Select LINK: "
D ^DIC
QUIT $S(+Y:+Y,1:"")
;
QUEUES N LNM,LNO
KILL ^TMP($J,"ZZLJA")
S LNM=""
F S LNM=$O(^HLCS(870,"B",LNM)) Q:LNM']"" D
. S LNO=0
. F S LNO=$O(^HLCS(870,"B",LNM,LNO)) Q:'LNO D
. . S LNS=$$LNM(LNO)
. . I $O(^HLCS(870,+LNO,1,0))>0 D
. . . S ^TMP($J,"ZZLJA",LNS,1)=$P($G(^HLCS(870,+LNO,1,0)),U,3)
. . I $O(^HLCS(870,+LNO,2,0))>0 D
. . . S ^TMP($J,"ZZLJA",LNS,2)=$P($G(^HLCS(870,+LNO,2,0)),U,3)
;
W !!,"Links with queues"
W !,"Link",?30,"IQ Totals",?45,"OQ Totals"
W !,$$REPEAT^XLFSTR("-",IOM)
;
S LNS=""
F S LNS=$O(^TMP($J,"ZZLJA",LNS)) Q:LNS']"" D
. W !
. W:LNS["Mail]" IOINHI W $E(LNS_" --------------------",1,20),IOINORM
. F WAY=1,2 D
. . S TOT=$G(^TMP($J,"ZZLJA",LNS,WAY))
. . S TOT=$E("---------------",1,15-$L(TOT))_TOT
. . W TOT
;
KILL ^TMP($J,"ZZLJA")
;
Q
;
LNM(L870) N GBL,X
S GBL="^HLCS(870,"_L870_")",X=$G(@GBL@(0))
Q $P(X,U)_" #"_L870_" ["_$P("Mail^HLLP^X3.28^TCP",U,+$P(X,U,3))_"] "
;
ASKNO(LNM,L870,WAY) ; Ask for beginning IEN to display...
N DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
S FIRST=$O(^HLCS(870,+L870,WAY,0))
S LAST=$O(^HLCS(870,+L870,WAY,":"),-1)
W !!,"First IEN = ",FIRST
W !," Last IEN = ",LAST
W !
S DIR(0)="N^"_FIRST_":"_LAST,DIR("A")="Enter IEN"
I FIRST S DIR("B")=FIRST
D ^DIR
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) U ;->
QUIT:+Y>0 (+Y-1) ;-> Will be used for $ORDER
Q 0
;
ASKWAY() ; In or Out...
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="S^1:Inbound Queue;2:Outbound Queue"
S DIR("A")="Select QUEUE"
D ^DIR
QUIT:+Y>0&(+Y<3) $P("1^2",U,+Y)
Q U
;
SEARCH(L870,WAY,NO,SKIP) ; Search for a date...
; LNM -- req
N ABRT,CONT,CT,NUM
I '$D(SKIP) N SKIP
S1 S SKIP=$S($G(SKIP):+SKIP,1:5000),ABRT=0,CT=0,CONT=0
S NUM=NO-1,NUM=$O(^HLCS(870,+L870,WAY,NUM))
W !!
D SRCH1(L870,WAY,+NUM)
F D QUIT:NUM'>0!(ABRT)
. S NUM=NUM+SKIP
. S NUM=$O(^HLCS(870,+L870,WAY,NUM)) QUIT:NUM'>0 ;->
. D SRCH1(L870,WAY,+NUM)
W !,"Just completed a search using a starting point of IEN=",NO,", and an offset"
W !,"of #",SKIP,". You may now enter a new starting IEN and offset."
W !
S NO=$$ASKNO(LNM,L870,WAY) QUIT:NO[U ;->
R !,"Enter OFFSET: ",OFFSET:90 I OFFSET>0 S SKIP=OFFSET G S1 ;->
Q
;
SRCH1(L870,WAY,IEN) ; Show date of entry...
N MSH,DATE,DEL
S MSH=$G(^HLCS(870,+L870,WAY,IEN,1,1,0))
S DEL=$E(MSH,4),DATE=$P(MSH,DEL,7)
S DATE=$S(DATE?14N.1"-".N:$$HTFM^XLFDT(DATE),1:"")
S DATE=$S(DATE?7N.E:DATE,1:$P($G(^HLCS(870,+L870,WAY,IEN,1,0)),U,5))
QUIT:DATE'?7N.E ;->
W $J($$SDT(DATE)_"(#"_IEN_")",18)_" "
S CT=CT+1
I 'CONT,'(CT#80) R X:999 S:X[U ABRT=1 S:X=" " CONT=1
Q
;
SDT(DATE) ; Return shortened form of date...
I DATE?7N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3) ;->
I DATE?7N1"."1.N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_"@"_$E($P($$FMTE^XLFDT(DATE),"@",2),1,5)
QUIT ""
;
TEST ; Hardwire IENs and test M code in monitor (only)...
N IEN,MCODE,STATE,WAY
;
W @IOF,$$CJ^XLFSTR("Monitor Test Utility",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
W !,"This utility sets the ^TMP(""HLEVFLAG"",$J) node to ""STOP"" to avoid any"
W !,"Event Monitor activity. This enables the debugging of M code."
;
S STATE=$G(^TMP("HLEVFLAG",$J))
;
F D QUIT:'IEN
. W !
. S IEN=$$ASKIEN^HLEVREP(776.1) QUIT:'IEN ;->
.
. S MCODE=$TR($P($G(^HLEV(776.1,+IEN,0)),U,6),"~",U)
. I MCODE']"" W " no M code found..." QUIT ;->
. W !!,"M code = ",MCODE
.
. W !!,"You may ZG ",MCODE," or D ",MCODE,"..."
. W !
. S WAY=$$YN^HLCSRPT4("DO the MCODE","Yes")
. S WAY=$S(WAY=1:1,1:2) ; 1=DO, 2=ZG
.
. W !
. I '$$YN^HLCSRPT4("OK to test now","Yes") D QUIT ;->
. . W " no action taken..."
.
. S ^TMP("HLEVFLAG",$J)="STOP"
.
. D TESTRUN
.
. KILL ^TMP("HLEVFLAG",$J)
. W !!,$$REPEAT^XLFSTR("-",IOM)
;
I STATE]"" S ^TMP("HLEVFLAG",$J)=STATE
;
Q
;
TESTRUN ; Call here from above to avoid LEVEL ERRORs with ZGo...
; MCODE,WAY -- req
I WAY=1 D
. W " DOing ",MCODE,"... "
. D @MCODE
I WAY=2 D
. W " ZGOing ",MCODE,"... "
. X "ZG "_@MCODE
Q
;
COLLECT(I772) ; Collect 772 & 773 data...
N CT,I773
D ADD(""),ADD($$CJ^XLFSTR(" 772# "_I772_" ",74,"-"))
S I773=0,CT=0
F S I773=$O(^TMP($J,"HLIEN",IEN,I773)) Q:'I773 D
. I CT>0 D ADD("")
. D COLL773(+I773)
. S CT=CT+1
D ADD($$CJ^XLFSTR("----------------------------------------",74))
D COLL772(+I772)
Q
;
COLL773(I773) ;
N LP,ST
S LP="^HLMA("_I773,ST=LP_",",LP=LP_")"
F S LP=$Q(@LP) Q:LP'[ST D
. D ADD(LP_"="_@LP)
Q
;
COLL772(I772) ;
N CT,LASTIN,LP,ST
S LP="^HL(772,"_I772,ST=LP_",",LP=LP_")",CT=0,LASTIN=""
F S LP=$Q(@LP) Q:LP'[ST D
. I $TR(LP,"""","")?1"^HL(772,"1.N1",IN,"1.N.E D QUIT:CT>5 ;->
. . S CT=CT+1
. . I CT=7 D ADD("... some data not shown ...")
. . S LASTIN=LP
. D ADD(LP_"="_@LP)
I LASTIN]"",CT>6 D ADD(LASTIN_"="_@LASTIN)
Q
;
ADD(TXT) ; Add text for report...
; SCRN -- req
N NO,POSX
S POSX=$L($P(TXT,"="))+1
F D QUIT:TXT']""
. I 'SCRN D ; Store for email message...
. . S NO=$O(^TMP($J,"HLMAIL",":"),-1)+1
. . S ^TMP($J,"HLMAIL",+NO)=$E(TXT,1,74)
. I SCRN W !,$E(TXT,1,74) ; Display on-screen
. S TXT=$E(TXT,75,999) QUIT:TXT']"" ;->
. S TXT=$$REPEAT^XLFSTR(" ",$S(POSX:POSX,1:5))_TXT
Q
;
DOLRO(TAG,SNO) ; Store debug data in ^XTMP("HLEVUTI1 "_DT,NO)...
N NO,X,XTMP
;
S XTMP="HLEVUTI1 "_TAG_"-"_DT
S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,1)_U_$$NOW^XLFDT_"^Debug data created by DOLRO~HLEVUTI1"
;
S NO=$O(^XTMP(XTMP,":"),-1)+1,NO=$S(NO>($G(SNO)-1):NO,1:SNO)
;
S X="^XTMP("""_XTMP_""","_NO_"," D DOLRO^%ZOSV
;
Q
;
EOR ;HLEVUTI1 - Event Monitor UTILITIES ;5/16/03 14:42
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVUTI1 8551 printed Sep 23, 2025@19:34:06 Page 2
HLEVUTI1 ;OIFO-O/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;;
+3 ;
+4 ; Utility to aid in displaying 870 data...
+5 ;
CTRL ;
+1 NEW ABRT,CT,CONT,DATA,DATE,DIC,GBL,HD,IOINHI,IOINORM,L870,LAST
+2 NEW LNM,LNO,LNS,N,NO,NODE,TOT,TXT,WAY,WHAT,X,Y
+3 ;
+4 SET X="IOINHI;IOINORM"
DO ENDR^%ZISS
CTRL0 WRITE @IOF,$$CJ^XLFSTR("Logical Link Display",IOM),!,$$REPEAT^XLFSTR("=",IOM)
+1 DO QUEUES
+2 WRITE !
SET L870=$$LINK
if 'L870
QUIT
+3 SET GBL="^HLCS(870,"_L870_")"
+4 SET LNM=$$LNM(L870)
+5 WRITE " ",LNM
CTRL1 DO SHOWHD(LNM,L870)
+1 WRITE !!,"What information for IN and OUT QUEUEs do you want to see?"
+2 WRITE !!,"1 Show IENs",!,"2 Show Summary nodes",!,"3 Totals",!,"4 Dots",!,"5 Find skips",!,"6 Message date search"
+3 ;->
READ !!,"Enter #: ",WHAT:99
if WHAT<1!(WHAT>6)
GOTO CTRL0
+4 WRITE !!,$$CJ^XLFSTR(" "_IOINHI_LNM_IOINORM_" ",IOM+$LENGTH(IOINHI)+$LENGTH(IOINORM),"=")
+5 SET ABRT=0
SET CONT=0
SET CT=0
+6 ;->
SET WAY=$$ASKWAY
if WAY[U
QUIT
+7 ;->
SET NO=$$ASKNO(LNM,L870,WAY)
if NO[U
QUIT
+8 ;->
IF WHAT=6
DO SEARCH(L870,WAY,NO)
GOTO CTRL1
+9 SET TOT(WAY)=0
SET LAST=""
+10 ;->
if $ORDER(@GBL@(WAY,0))'>0
QUIT
+11 WRITE !,$$CJ^XLFSTR(" "_$SELECT(WAY=1:"IN",1:"OUT")_" QUEUE ",IOM,"-")
+12 IF WHAT=3
WRITE !,"Totaling..."
+13 FOR
SET NO=$ORDER(@GBL@(WAY,NO))
if 'NO!ABRT
QUIT
Begin DoDot:1
+14 SET CT=CT+1
+15 SET NODE=$GET(@GBL@(WAY,NO,0))
SET DATE=$PIECE($GET(@GBL@(WAY,NO,1,0)),U,5)
+16 SET TXT=$GET(@GBL@(WAY,NO,1,1,0))
+17 SET TXT=$EXTRACT(DATE_" ",1,10)_$EXTRACT(NODE_" ",1,12)_" "_$EXTRACT(TXT,1,56)
+18 IF WHAT=1
if ($X+$LENGTH(NO)+1)>IOM
WRITE !
if $X>0
WRITE ","
WRITE NO
+19 IF WHAT=2
Begin DoDot:2
+20 WRITE !,TXT
End DoDot:2
+21 IF WHAT=3
if '(CT#5000)
WRITE "."
SET TOT(WAY)=TOT(WAY)+1
+22 IF WHAT=4
if $$CT
QUIT
WRITE "."
+23 IF WHAT=5
Begin DoDot:2
+24 IF LAST
IF +LAST'=(NO-1)
Begin DoDot:3
+25 WRITE !,+LAST,?10," ",$EXTRACT($PIECE(LAST,"~",2,999),1,IOM-$X)
+26 WRITE !,+NO,?10," ",$EXTRACT(TXT,1,69)
End DoDot:3
+27 SET LAST=NO_"~"_TXT
End DoDot:2
+28 IF 'CONT
IF '(CT#20)
READ X:999
if X[U
SET ABRT=1
if X=" "
SET CONT=1
End DoDot:1
+29 IF 'ABRT
IF TOT(WAY)
WRITE !,"--- Total = #",TOT(WAY)
+30 SET ABRT=""
SET CT=0
+31 ;
+32 READ !,"End of output... ",X:999
+33 ;
+34 WRITE !!,$$CJ^XLFSTR(" "_LNM_" ",IOM,"=")
+35 ;
+36 ;->
GOTO CTRL1
+37 ;
SHOWHD(LNM,L870) ; Show summary information...
+1 NEW NODE
+2 WRITE !!,$$REPEAT^XLFSTR("=",IOM)
+3 FOR NODE=0,100,200,300,400,"IN QUEUE BACK POINTER","IN QUEUE FRONT POINTER","OUT QUEUE BACK POINTER","OUT QUEUE FRONT POINTER"
Begin DoDot:1
+4 ;->
SET DATA=$GET(@GBL@(NODE))
if DATA']""
QUIT
+5 DO PHD(NODE,DATA)
End DoDot:1
+6 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+7 QUIT
+8 ;
CT() if (CT#500)
QUIT ""
+1 READ X:999
if X']""
QUIT ""
+2 SET ABRT=1
+3 QUIT 1
+4 ;
PHD(HD,DATA) ;
+1 SET HD=$$HD(HD)
+2 SET HD=$EXTRACT(" ",1,4-$LENGTH(HD))_HD
+3 WRITE !,HD,"="
+4 FOR
Begin DoDot:1
+5 if DATA']""
QUIT
+6 WRITE $EXTRACT(DATA,1,76)
+7 SET DATA=$EXTRACT(DATA,77,999)
+8 if DATA]""
WRITE !,?4
End DoDot:1
if DATA']""
QUIT
+9 QUIT
+10 ;
HD(HD) ;
+1 IF HD["IN QUEUE F"
SET HD="IQFP"
+2 IF HD["IN QUEUE B"
SET HD="IQBP"
+3 IF HD["OUT QUEUE F"
SET HD="OQFP"
+4 IF HD["OUT QUEUE B"
SET HD="OQBP"
+5 QUIT HD
+6 ;
LINK() NEW DIC,X,Y
+1 SET DIC=870
SET DIC(0)="AEMQN"
SET DIC("A")="Select LINK: "
+2 DO ^DIC
+3 QUIT $SELECT(+Y:+Y,1:"")
+4 ;
QUEUES NEW LNM,LNO
+1 KILL ^TMP($JOB,"ZZLJA")
+2 SET LNM=""
+3 FOR
SET LNM=$ORDER(^HLCS(870,"B",LNM))
if LNM']""
QUIT
Begin DoDot:1
+4 SET LNO=0
+5 FOR
SET LNO=$ORDER(^HLCS(870,"B",LNM,LNO))
if 'LNO
QUIT
Begin DoDot:2
+6 SET LNS=$$LNM(LNO)
+7 IF $ORDER(^HLCS(870,+LNO,1,0))>0
Begin DoDot:3
+8 SET ^TMP($JOB,"ZZLJA",LNS,1)=$PIECE($GET(^HLCS(870,+LNO,1,0)),U,3)
End DoDot:3
+9 IF $ORDER(^HLCS(870,+LNO,2,0))>0
Begin DoDot:3
+10 SET ^TMP($JOB,"ZZLJA",LNS,2)=$PIECE($GET(^HLCS(870,+LNO,2,0)),U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
+12 WRITE !!,"Links with queues"
+13 WRITE !,"Link",?30,"IQ Totals",?45,"OQ Totals"
+14 WRITE !,$$REPEAT^XLFSTR("-",IOM)
+15 ;
+16 SET LNS=""
+17 FOR
SET LNS=$ORDER(^TMP($JOB,"ZZLJA",LNS))
if LNS']""
QUIT
Begin DoDot:1
+18 WRITE !
+19 if LNS["Mail]"
WRITE IOINHI
WRITE $EXTRACT(LNS_" --------------------",1,20),IOINORM
+20 FOR WAY=1,2
Begin DoDot:2
+21 SET TOT=$GET(^TMP($JOB,"ZZLJA",LNS,WAY))
+22 SET TOT=$EXTRACT("---------------",1,15-$LENGTH(TOT))_TOT
+23 WRITE TOT
End DoDot:2
End DoDot:1
+24 ;
+25 KILL ^TMP($JOB,"ZZLJA")
+26 ;
+27 QUIT
+28 ;
LNM(L870) NEW GBL,X
+1 SET GBL="^HLCS(870,"_L870_")"
SET X=$GET(@GBL@(0))
+2 QUIT $PIECE(X,U)_" #"_L870_" ["_$PIECE("Mail^HLLP^X3.28^TCP",U,+$PIECE(X,U,3))_"] "
+3 ;
ASKNO(LNM,L870,WAY) ; Ask for beginning IEN to display...
+1 NEW DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
+2 SET FIRST=$ORDER(^HLCS(870,+L870,WAY,0))
+3 SET LAST=$ORDER(^HLCS(870,+L870,WAY,":"),-1)
+4 WRITE !!,"First IEN = ",FIRST
+5 WRITE !," Last IEN = ",LAST
+6 WRITE !
+7 SET DIR(0)="N^"_FIRST_":"_LAST
SET DIR("A")="Enter IEN"
+8 IF FIRST
SET DIR("B")=FIRST
+9 DO ^DIR
+10 ;->
if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT U
+11 ;-> Will be used for $ORDER
if +Y>0
QUIT (+Y-1)
+12 QUIT 0
+13 ;
ASKWAY() ; In or Out...
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="S^1:Inbound Queue;2:Outbound Queue"
+3 SET DIR("A")="Select QUEUE"
+4 DO ^DIR
+5 if +Y>0&(+Y<3)
QUIT $PIECE("1^2",U,+Y)
+6 QUIT U
+7 ;
SEARCH(L870,WAY,NO,SKIP) ; Search for a date...
+1 ; LNM -- req
+2 NEW ABRT,CONT,CT,NUM
+3 IF '$DATA(SKIP)
NEW SKIP
S1 SET SKIP=$SELECT($GET(SKIP):+SKIP,1:5000)
SET ABRT=0
SET CT=0
SET CONT=0
+1 SET NUM=NO-1
SET NUM=$ORDER(^HLCS(870,+L870,WAY,NUM))
+2 WRITE !!
+3 DO SRCH1(L870,WAY,+NUM)
+4 FOR
Begin DoDot:1
+5 SET NUM=NUM+SKIP
+6 ;->
SET NUM=$ORDER(^HLCS(870,+L870,WAY,NUM))
if NUM'>0
QUIT
+7 DO SRCH1(L870,WAY,+NUM)
End DoDot:1
if NUM'>0!(ABRT)
QUIT
+8 WRITE !,"Just completed a search using a starting point of IEN=",NO,", and an offset"
+9 WRITE !,"of #",SKIP,". You may now enter a new starting IEN and offset."
+10 WRITE !
+11 ;->
SET NO=$$ASKNO(LNM,L870,WAY)
if NO[U
QUIT
+12 ;->
READ !,"Enter OFFSET: ",OFFSET:90
IF OFFSET>0
SET SKIP=OFFSET
GOTO S1
+13 QUIT
+14 ;
SRCH1(L870,WAY,IEN) ; Show date of entry...
+1 NEW MSH,DATE,DEL
+2 SET MSH=$GET(^HLCS(870,+L870,WAY,IEN,1,1,0))
+3 SET DEL=$EXTRACT(MSH,4)
SET DATE=$PIECE(MSH,DEL,7)
+4 SET DATE=$SELECT(DATE?14N.1"-".N:$$HTFM^XLFDT(DATE),1:"")
+5 SET DATE=$SELECT(DATE?7N.E:DATE,1:$PIECE($GET(^HLCS(870,+L870,WAY,IEN,1,0)),U,5))
+6 ;->
if DATE'?7N.E
QUIT
+7 WRITE $JUSTIFY($$SDT(DATE)_"(#"_IEN_")",18)_" "
+8 SET CT=CT+1
+9 IF 'CONT
IF '(CT#80)
READ X:999
if X[U
SET ABRT=1
if X=" "
SET CONT=1
+10 QUIT
+11 ;
SDT(DATE) ; Return shortened form of date...
+1 ;->
IF DATE?7N
QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+2 IF DATE?7N1"."1.N
QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)_"@"_$EXTRACT($PIECE($$FMTE^XLFDT(DATE),"@",2),1,5)
+3 QUIT ""
+4 ;
TEST ; Hardwire IENs and test M code in monitor (only)...
+1 NEW IEN,MCODE,STATE,WAY
+2 ;
+3 WRITE @IOF,$$CJ^XLFSTR("Monitor Test Utility",IOM)
+4 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+5 WRITE !,"This utility sets the ^TMP(""HLEVFLAG"",$J) node to ""STOP"" to avoid any"
+6 WRITE !,"Event Monitor activity. This enables the debugging of M code."
+7 ;
+8 SET STATE=$GET(^TMP("HLEVFLAG",$JOB))
+9 ;
+10 FOR
Begin DoDot:1
+11 WRITE !
+12 ;->
SET IEN=$$ASKIEN^HLEVREP(776.1)
if 'IEN
QUIT
+13 +14 SET MCODE=$TRANSLATE($PIECE($GET(^HLEV(776.1,+IEN,0)),U,6),"~",U)
+15 ;->
IF MCODE']""
WRITE " no M code found..."
QUIT
+16 WRITE !!,"M code = ",MCODE
+17 +18 WRITE !!,"You may ZG ",MCODE," or D ",MCODE,"..."
+19 WRITE !
+20 SET WAY=$$YN^HLCSRPT4("DO the MCODE","Yes")
+21 ; 1=DO, 2=ZG
SET WAY=$SELECT(WAY=1:1,1:2)
+22 +23 WRITE !
+24 ;->
IF '$$YN^HLCSRPT4("OK to test now","Yes")
Begin DoDot:2
+25 WRITE " no action taken..."
End DoDot:2
QUIT
+26 +27 SET ^TMP("HLEVFLAG",$JOB)="STOP"
+28 +29 DO TESTRUN
+30 +31 KILL ^TMP("HLEVFLAG",$JOB)
+32 WRITE !!,$$REPEAT^XLFSTR("-",IOM)
End DoDot:1
if 'IEN
QUIT
+33 ;
+34 IF STATE]""
SET ^TMP("HLEVFLAG",$JOB)=STATE
+35 ;
+36 QUIT
+37 ;
TESTRUN ; Call here from above to avoid LEVEL ERRORs with ZGo...
+1 ; MCODE,WAY -- req
+2 IF WAY=1
Begin DoDot:1
+3 WRITE " DOing ",MCODE,"... "
+4 DO @MCODE
End DoDot:1
+5 IF WAY=2
Begin DoDot:1
+6 WRITE " ZGOing ",MCODE,"... "
+7 XECUTE "ZG "_@MCODE
End DoDot:1
+8 QUIT
+9 ;
COLLECT(I772) ; Collect 772 & 773 data...
+1 NEW CT,I773
+2 DO ADD("")
DO ADD($$CJ^XLFSTR(" 772# "_I772_" ",74,"-"))
+3 SET I773=0
SET CT=0
+4 FOR
SET I773=$ORDER(^TMP($JOB,"HLIEN",IEN,I773))
if 'I773
QUIT
Begin DoDot:1
+5 IF CT>0
DO ADD("")
+6 DO COLL773(+I773)
+7 SET CT=CT+1
End DoDot:1
+8 DO ADD($$CJ^XLFSTR("----------------------------------------",74))
+9 DO COLL772(+I772)
+10 QUIT
+11 ;
COLL773(I773) ;
+1 NEW LP,ST
+2 SET LP="^HLMA("_I773
SET ST=LP_","
SET LP=LP_")"
+3 FOR
SET LP=$QUERY(@LP)
if LP'[ST
QUIT
Begin DoDot:1
+4 DO ADD(LP_"="_@LP)
End DoDot:1
+5 QUIT
+6 ;
COLL772(I772) ;
+1 NEW CT,LASTIN,LP,ST
+2 SET LP="^HL(772,"_I772
SET ST=LP_","
SET LP=LP_")"
SET CT=0
SET LASTIN=""
+3 FOR
SET LP=$QUERY(@LP)
if LP'[ST
QUIT
Begin DoDot:1
+4 ;->
IF $TRANSLATE(LP,"""","")?1"^HL(772,"1.N1",IN,"1.N.E
Begin DoDot:2
+5 SET CT=CT+1
+6 IF CT=7
DO ADD("... some data not shown ...")
+7 SET LASTIN=LP
End DoDot:2
if CT>5
QUIT
+8 DO ADD(LP_"="_@LP)
End DoDot:1
+9 IF LASTIN]""
IF CT>6
DO ADD(LASTIN_"="_@LASTIN)
+10 QUIT
+11 ;
ADD(TXT) ; Add text for report...
+1 ; SCRN -- req
+2 NEW NO,POSX
+3 SET POSX=$LENGTH($PIECE(TXT,"="))+1
+4 FOR
Begin DoDot:1
+5 ; Store for email message...
IF 'SCRN
Begin DoDot:2
+6 SET NO=$ORDER(^TMP($JOB,"HLMAIL",":"),-1)+1
+7 SET ^TMP($JOB,"HLMAIL",+NO)=$EXTRACT(TXT,1,74)
End DoDot:2
+8 ; Display on-screen
IF SCRN
WRITE !,$EXTRACT(TXT,1,74)
+9 ;->
SET TXT=$EXTRACT(TXT,75,999)
if TXT']""
QUIT
+10 SET TXT=$$REPEAT^XLFSTR(" ",$SELECT(POSX:POSX,1:5))_TXT
End DoDot:1
if TXT']""
QUIT
+11 QUIT
+12 ;
DOLRO(TAG,SNO) ; Store debug data in ^XTMP("HLEVUTI1 "_DT,NO)...
+1 NEW NO,X,XTMP
+2 ;
+3 SET XTMP="HLEVUTI1 "_TAG_"-"_DT
+4 if '$DATA(^XTMP(XTMP,0))
SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,1)_U_$$NOW^XLFDT_"^Debug data created by DOLRO~HLEVUTI1"
+5 ;
+6 SET NO=$ORDER(^XTMP(XTMP,":"),-1)+1
SET NO=$SELECT(NO>($GET(SNO)-1):NO,1:SNO)
+7 ;
+8 SET X="^XTMP("""_XTMP_""","_NO_","
DO DOLRO^%ZOSV
+9 ;
+10 QUIT
+11 ;
EOR ;HLEVUTI1 - Event Monitor UTILITIES ;5/16/03 14:42
