| 1 | HLEVUTI1 ;OIFO-O/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | ;
|
|---|
| 5 | ; Utility to aid in displaying 870 data...
|
|---|
| 6 | ;
|
|---|
| 7 | CTRL ;
|
|---|
| 8 | N ABRT,CT,CONT,DATA,DATE,DIC,GBL,HD,IOINHI,IOINORM,L870,LAST
|
|---|
| 9 | N LNM,LNO,LNS,N,NO,NODE,TOT,TXT,WAY,WHAT,X,Y
|
|---|
| 10 | ;
|
|---|
| 11 | S X="IOINHI;IOINORM" D ENDR^%ZISS
|
|---|
| 12 | CTRL0 W @IOF,$$CJ^XLFSTR("Logical Link Display",IOM),!,$$REPEAT^XLFSTR("=",IOM)
|
|---|
| 13 | D QUEUES
|
|---|
| 14 | W ! S L870=$$LINK Q:'L870
|
|---|
| 15 | S GBL="^HLCS(870,"_L870_")"
|
|---|
| 16 | S LNM=$$LNM(L870)
|
|---|
| 17 | W " ",LNM
|
|---|
| 18 | CTRL1 D SHOWHD(LNM,L870)
|
|---|
| 19 | W !!,"What information for IN and OUT QUEUEs do you want to see?"
|
|---|
| 20 | W !!,"1 Show IENs",!,"2 Show Summary nodes",!,"3 Totals",!,"4 Dots",!,"5 Find skips",!,"6 Message date search"
|
|---|
| 21 | R !!,"Enter #: ",WHAT:99 G:WHAT<1!(WHAT>6) CTRL0 ;->
|
|---|
| 22 | W !!,$$CJ^XLFSTR(" "_IOINHI_LNM_IOINORM_" ",IOM+$L(IOINHI)+$L(IOINORM),"=")
|
|---|
| 23 | S ABRT=0,CONT=0,CT=0
|
|---|
| 24 | S WAY=$$ASKWAY QUIT:WAY[U ;->
|
|---|
| 25 | S NO=$$ASKNO(LNM,L870,WAY) QUIT:NO[U ;->
|
|---|
| 26 | I WHAT=6 D SEARCH(L870,WAY,NO) G CTRL1 ;->
|
|---|
| 27 | S TOT(WAY)=0,LAST=""
|
|---|
| 28 | QUIT:$O(@GBL@(WAY,0))'>0 ;->
|
|---|
| 29 | W !,$$CJ^XLFSTR(" "_$S(WAY=1:"IN",1:"OUT")_" QUEUE ",IOM,"-")
|
|---|
| 30 | I WHAT=3 W !,"Totaling..."
|
|---|
| 31 | F S NO=$O(@GBL@(WAY,NO)) Q:'NO!ABRT D
|
|---|
| 32 | . S CT=CT+1
|
|---|
| 33 | . S NODE=$G(@GBL@(WAY,NO,0)),DATE=$P($G(@GBL@(WAY,NO,1,0)),U,5)
|
|---|
| 34 | . S TXT=$G(@GBL@(WAY,NO,1,1,0))
|
|---|
| 35 | . S TXT=$E(DATE_" ",1,10)_$E(NODE_" ",1,12)_" "_$E(TXT,1,56)
|
|---|
| 36 | . I WHAT=1 W:($X+$L(NO)+1)>IOM ! W:$X>0 "," W NO
|
|---|
| 37 | . I WHAT=2 D
|
|---|
| 38 | . . W !,TXT
|
|---|
| 39 | . I WHAT=3 W:'(CT#5000) "." S TOT(WAY)=TOT(WAY)+1
|
|---|
| 40 | . I WHAT=4 Q:$$CT W "."
|
|---|
| 41 | . I WHAT=5 D
|
|---|
| 42 | . . I LAST,+LAST'=(NO-1) D
|
|---|
| 43 | . . . W !,+LAST,?10," ",$E($P(LAST,"~",2,999),1,IOM-$X)
|
|---|
| 44 | . . . W !,+NO,?10," ",$E(TXT,1,69)
|
|---|
| 45 | . . S LAST=NO_"~"_TXT
|
|---|
| 46 | . I 'CONT,'(CT#20) R X:999 S:X[U ABRT=1 S:X=" " CONT=1
|
|---|
| 47 | I 'ABRT,TOT(WAY) W !,"--- Total = #",TOT(WAY)
|
|---|
| 48 | S ABRT="",CT=0
|
|---|
| 49 | ;
|
|---|
| 50 | R !,"End of output... ",X:999
|
|---|
| 51 | ;
|
|---|
| 52 | W !!,$$CJ^XLFSTR(" "_LNM_" ",IOM,"=")
|
|---|
| 53 | ;
|
|---|
| 54 | G CTRL1 ;->
|
|---|
| 55 | ;
|
|---|
| 56 | SHOWHD(LNM,L870) ; Show summary information...
|
|---|
| 57 | N NODE
|
|---|
| 58 | W !!,$$REPEAT^XLFSTR("=",IOM)
|
|---|
| 59 | F NODE=0,100,200,300,400,"IN QUEUE BACK POINTER","IN QUEUE FRONT POINTER","OUT QUEUE BACK POINTER","OUT QUEUE FRONT POINTER" D
|
|---|
| 60 | . S DATA=$G(@GBL@(NODE)) Q:DATA']"" ;->
|
|---|
| 61 | . D PHD(NODE,DATA)
|
|---|
| 62 | W !,$$REPEAT^XLFSTR("=",IOM)
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | CT() QUIT:(CT#500) ""
|
|---|
| 66 | R X:999 Q:X']"" ""
|
|---|
| 67 | S ABRT=1
|
|---|
| 68 | Q 1
|
|---|
| 69 | ;
|
|---|
| 70 | PHD(HD,DATA) ;
|
|---|
| 71 | S HD=$$HD(HD)
|
|---|
| 72 | S HD=$E(" ",1,4-$L(HD))_HD
|
|---|
| 73 | W !,HD,"="
|
|---|
| 74 | F D QUIT:DATA']""
|
|---|
| 75 | . QUIT:DATA']""
|
|---|
| 76 | . W $E(DATA,1,76)
|
|---|
| 77 | . S DATA=$E(DATA,77,999)
|
|---|
| 78 | . W:DATA]"" !,?4
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | HD(HD) ;
|
|---|
| 82 | I HD["IN QUEUE F" S HD="IQFP"
|
|---|
| 83 | I HD["IN QUEUE B" S HD="IQBP"
|
|---|
| 84 | I HD["OUT QUEUE F" S HD="OQFP"
|
|---|
| 85 | I HD["OUT QUEUE B" S HD="OQBP"
|
|---|
| 86 | Q HD
|
|---|
| 87 | ;
|
|---|
| 88 | LINK() N DIC,X,Y
|
|---|
| 89 | S DIC=870,DIC(0)="AEMQN",DIC("A")="Select LINK: "
|
|---|
| 90 | D ^DIC
|
|---|
| 91 | QUIT $S(+Y:+Y,1:"")
|
|---|
| 92 | ;
|
|---|
| 93 | QUEUES N LNM,LNO
|
|---|
| 94 | KILL ^TMP($J,"ZZLJA")
|
|---|
| 95 | S LNM=""
|
|---|
| 96 | F S LNM=$O(^HLCS(870,"B",LNM)) Q:LNM']"" D
|
|---|
| 97 | . S LNO=0
|
|---|
| 98 | . F S LNO=$O(^HLCS(870,"B",LNM,LNO)) Q:'LNO D
|
|---|
| 99 | . . S LNS=$$LNM(LNO)
|
|---|
| 100 | . . I $O(^HLCS(870,+LNO,1,0))>0 D
|
|---|
| 101 | . . . S ^TMP($J,"ZZLJA",LNS,1)=$P($G(^HLCS(870,+LNO,1,0)),U,3)
|
|---|
| 102 | . . I $O(^HLCS(870,+LNO,2,0))>0 D
|
|---|
| 103 | . . . S ^TMP($J,"ZZLJA",LNS,2)=$P($G(^HLCS(870,+LNO,2,0)),U,3)
|
|---|
| 104 | ;
|
|---|
| 105 | W !!,"Links with queues"
|
|---|
| 106 | W !,"Link",?30,"IQ Totals",?45,"OQ Totals"
|
|---|
| 107 | W !,$$REPEAT^XLFSTR("-",IOM)
|
|---|
| 108 | ;
|
|---|
| 109 | S LNS=""
|
|---|
| 110 | F S LNS=$O(^TMP($J,"ZZLJA",LNS)) Q:LNS']"" D
|
|---|
| 111 | . W !
|
|---|
| 112 | . W:LNS["Mail]" IOINHI W $E(LNS_" --------------------",1,20),IOINORM
|
|---|
| 113 | . F WAY=1,2 D
|
|---|
| 114 | . . S TOT=$G(^TMP($J,"ZZLJA",LNS,WAY))
|
|---|
| 115 | . . S TOT=$E("---------------",1,15-$L(TOT))_TOT
|
|---|
| 116 | . . W TOT
|
|---|
| 117 | ;
|
|---|
| 118 | KILL ^TMP($J,"ZZLJA")
|
|---|
| 119 | ;
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | LNM(L870) N GBL,X
|
|---|
| 123 | S GBL="^HLCS(870,"_L870_")",X=$G(@GBL@(0))
|
|---|
| 124 | Q $P(X,U)_" #"_L870_" ["_$P("Mail^HLLP^X3.28^TCP",U,+$P(X,U,3))_"] "
|
|---|
| 125 | ;
|
|---|
| 126 | ASKNO(LNM,L870,WAY) ; Ask for beginning IEN to display...
|
|---|
| 127 | N DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
|
|---|
| 128 | S FIRST=$O(^HLCS(870,+L870,WAY,0))
|
|---|
| 129 | S LAST=$O(^HLCS(870,+L870,WAY,":"),-1)
|
|---|
| 130 | W !!,"First IEN = ",FIRST
|
|---|
| 131 | W !," Last IEN = ",LAST
|
|---|
| 132 | W !
|
|---|
| 133 | S DIR(0)="N^"_FIRST_":"_LAST,DIR("A")="Enter IEN"
|
|---|
| 134 | I FIRST S DIR("B")=FIRST
|
|---|
| 135 | D ^DIR
|
|---|
| 136 | QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) U ;->
|
|---|
| 137 | QUIT:+Y>0 (+Y-1) ;-> Will be used for $ORDER
|
|---|
| 138 | Q 0
|
|---|
| 139 | ;
|
|---|
| 140 | ASKWAY() ; In or Out...
|
|---|
| 141 | N DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 142 | S DIR(0)="S^1:Inbound Queue;2:Outbound Queue"
|
|---|
| 143 | S DIR("A")="Select QUEUE"
|
|---|
| 144 | D ^DIR
|
|---|
| 145 | QUIT:+Y>0&(+Y<3) $P("1^2",U,+Y)
|
|---|
| 146 | Q U
|
|---|
| 147 | ;
|
|---|
| 148 | SEARCH(L870,WAY,NO,SKIP) ; Search for a date...
|
|---|
| 149 | ; LNM -- req
|
|---|
| 150 | N ABRT,CONT,CT,NUM
|
|---|
| 151 | I '$D(SKIP) N SKIP
|
|---|
| 152 | S1 S SKIP=$S($G(SKIP):+SKIP,1:5000),ABRT=0,CT=0,CONT=0
|
|---|
| 153 | S NUM=NO-1,NUM=$O(^HLCS(870,+L870,WAY,NUM))
|
|---|
| 154 | W !!
|
|---|
| 155 | D SRCH1(L870,WAY,+NUM)
|
|---|
| 156 | F D QUIT:NUM'>0!(ABRT)
|
|---|
| 157 | . S NUM=NUM+SKIP
|
|---|
| 158 | . S NUM=$O(^HLCS(870,+L870,WAY,NUM)) QUIT:NUM'>0 ;->
|
|---|
| 159 | . D SRCH1(L870,WAY,+NUM)
|
|---|
| 160 | W !,"Just completed a search using a starting point of IEN=",NO,", and an offset"
|
|---|
| 161 | W !,"of #",SKIP,". You may now enter a new starting IEN and offset."
|
|---|
| 162 | W !
|
|---|
| 163 | S NO=$$ASKNO(LNM,L870,WAY) QUIT:NO[U ;->
|
|---|
| 164 | R !,"Enter OFFSET: ",OFFSET:90 I OFFSET>0 S SKIP=OFFSET G S1 ;->
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | SRCH1(L870,WAY,IEN) ; Show date of entry...
|
|---|
| 168 | N MSH,DATE,DEL
|
|---|
| 169 | S MSH=$G(^HLCS(870,+L870,WAY,IEN,1,1,0))
|
|---|
| 170 | S DEL=$E(MSH,4),DATE=$P(MSH,DEL,7)
|
|---|
| 171 | S DATE=$S(DATE?14N.1"-".N:$$HTFM^XLFDT(DATE),1:"")
|
|---|
| 172 | S DATE=$S(DATE?7N.E:DATE,1:$P($G(^HLCS(870,+L870,WAY,IEN,1,0)),U,5))
|
|---|
| 173 | QUIT:DATE'?7N.E ;->
|
|---|
| 174 | W $J($$SDT(DATE)_"(#"_IEN_")",18)_" "
|
|---|
| 175 | S CT=CT+1
|
|---|
| 176 | I 'CONT,'(CT#80) R X:999 S:X[U ABRT=1 S:X=" " CONT=1
|
|---|
| 177 | Q
|
|---|
| 178 | ;
|
|---|
| 179 | SDT(DATE) ; Return shortened form of date...
|
|---|
| 180 | I DATE?7N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3) ;->
|
|---|
| 181 | 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)
|
|---|
| 182 | QUIT ""
|
|---|
| 183 | ;
|
|---|
| 184 | TEST ; Hardwire IENs and test M code in monitor (only)...
|
|---|
| 185 | N IEN,MCODE,STATE,WAY
|
|---|
| 186 | ;
|
|---|
| 187 | W @IOF,$$CJ^XLFSTR("Monitor Test Utility",IOM)
|
|---|
| 188 | W !,$$REPEAT^XLFSTR("=",IOM)
|
|---|
| 189 | W !,"This utility sets the ^TMP(""HLEVFLAG"",$J) node to ""STOP"" to avoid any"
|
|---|
| 190 | W !,"Event Monitor activity. This enables the debugging of M code."
|
|---|
| 191 | ;
|
|---|
| 192 | S STATE=$G(^TMP("HLEVFLAG",$J))
|
|---|
| 193 | ;
|
|---|
| 194 | F D QUIT:'IEN
|
|---|
| 195 | . W !
|
|---|
| 196 | . S IEN=$$ASKIEN^HLEVREP(776.1) QUIT:'IEN ;->
|
|---|
| 197 | .
|
|---|
| 198 | . S MCODE=$TR($P($G(^HLEV(776.1,+IEN,0)),U,6),"~",U)
|
|---|
| 199 | . I MCODE']"" W " no M code found..." QUIT ;->
|
|---|
| 200 | . W !!,"M code = ",MCODE
|
|---|
| 201 | .
|
|---|
| 202 | . W !!,"You may ZG ",MCODE," or D ",MCODE,"..."
|
|---|
| 203 | . W !
|
|---|
| 204 | . S WAY=$$YN^HLCSRPT4("DO the MCODE","Yes")
|
|---|
| 205 | . S WAY=$S(WAY=1:1,1:2) ; 1=DO, 2=ZG
|
|---|
| 206 | .
|
|---|
| 207 | . W !
|
|---|
| 208 | . I '$$YN^HLCSRPT4("OK to test now","Yes") D QUIT ;->
|
|---|
| 209 | . . W " no action taken..."
|
|---|
| 210 | .
|
|---|
| 211 | . S ^TMP("HLEVFLAG",$J)="STOP"
|
|---|
| 212 | .
|
|---|
| 213 | . D TESTRUN
|
|---|
| 214 | .
|
|---|
| 215 | . KILL ^TMP("HLEVFLAG",$J)
|
|---|
| 216 | . W !!,$$REPEAT^XLFSTR("-",IOM)
|
|---|
| 217 | ;
|
|---|
| 218 | I STATE]"" S ^TMP("HLEVFLAG",$J)=STATE
|
|---|
| 219 | ;
|
|---|
| 220 | Q
|
|---|
| 221 | ;
|
|---|
| 222 | TESTRUN ; Call here from above to avoid LEVEL ERRORs with ZGo...
|
|---|
| 223 | ; MCODE,WAY -- req
|
|---|
| 224 | I WAY=1 D
|
|---|
| 225 | . W " DOing ",MCODE,"... "
|
|---|
| 226 | . D @MCODE
|
|---|
| 227 | I WAY=2 D
|
|---|
| 228 | . W " ZGOing ",MCODE,"... "
|
|---|
| 229 | . X "ZG "_@MCODE
|
|---|
| 230 | Q
|
|---|
| 231 | ;
|
|---|
| 232 | COLLECT(I772) ; Collect 772 & 773 data...
|
|---|
| 233 | N CT,I773
|
|---|
| 234 | D ADD(""),ADD($$CJ^XLFSTR(" 772# "_I772_" ",74,"-"))
|
|---|
| 235 | S I773=0,CT=0
|
|---|
| 236 | F S I773=$O(^TMP($J,"HLIEN",IEN,I773)) Q:'I773 D
|
|---|
| 237 | . I CT>0 D ADD("")
|
|---|
| 238 | . D COLL773(+I773)
|
|---|
| 239 | . S CT=CT+1
|
|---|
| 240 | D ADD($$CJ^XLFSTR("----------------------------------------",74))
|
|---|
| 241 | D COLL772(+I772)
|
|---|
| 242 | Q
|
|---|
| 243 | ;
|
|---|
| 244 | COLL773(I773) ;
|
|---|
| 245 | N LP,ST
|
|---|
| 246 | S LP="^HLMA("_I773,ST=LP_",",LP=LP_")"
|
|---|
| 247 | F S LP=$Q(@LP) Q:LP'[ST D
|
|---|
| 248 | . D ADD(LP_"="_@LP)
|
|---|
| 249 | Q
|
|---|
| 250 | ;
|
|---|
| 251 | COLL772(I772) ;
|
|---|
| 252 | N CT,LASTIN,LP,ST
|
|---|
| 253 | S LP="^HL(772,"_I772,ST=LP_",",LP=LP_")",CT=0,LASTIN=""
|
|---|
| 254 | F S LP=$Q(@LP) Q:LP'[ST D
|
|---|
| 255 | . I $TR(LP,"""","")?1"^HL(772,"1.N1",IN,"1.N.E D QUIT:CT>5 ;->
|
|---|
| 256 | . . S CT=CT+1
|
|---|
| 257 | . . I CT=7 D ADD("... some data not shown ...")
|
|---|
| 258 | . . S LASTIN=LP
|
|---|
| 259 | . D ADD(LP_"="_@LP)
|
|---|
| 260 | I LASTIN]"",CT>6 D ADD(LASTIN_"="_@LASTIN)
|
|---|
| 261 | Q
|
|---|
| 262 | ;
|
|---|
| 263 | ADD(TXT) ; Add text for report...
|
|---|
| 264 | ; SCRN -- req
|
|---|
| 265 | N NO,POSX
|
|---|
| 266 | S POSX=$L($P(TXT,"="))+1
|
|---|
| 267 | F D QUIT:TXT']""
|
|---|
| 268 | . I 'SCRN D ; Store for email message...
|
|---|
| 269 | . . S NO=$O(^TMP($J,"HLMAIL",":"),-1)+1
|
|---|
| 270 | . . S ^TMP($J,"HLMAIL",+NO)=$E(TXT,1,74)
|
|---|
| 271 | . I SCRN W !,$E(TXT,1,74) ; Display on-screen
|
|---|
| 272 | . S TXT=$E(TXT,75,999) QUIT:TXT']"" ;->
|
|---|
| 273 | . S TXT=$$REPEAT^XLFSTR(" ",$S(POSX:POSX,1:5))_TXT
|
|---|
| 274 | Q
|
|---|
| 275 | ;
|
|---|
| 276 | DOLRO(TAG,SNO) ; Store debug data in ^XTMP("HLEVUTI1 "_DT,NO)...
|
|---|
| 277 | N NO,X,XTMP
|
|---|
| 278 | ;
|
|---|
| 279 | S XTMP="HLEVUTI1 "_TAG_"-"_DT
|
|---|
| 280 | S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,1)_U_$$NOW^XLFDT_"^Debug data created by DOLRO~HLEVUTI1"
|
|---|
| 281 | ;
|
|---|
| 282 | S NO=$O(^XTMP(XTMP,":"),-1)+1,NO=$S(NO>($G(SNO)-1):NO,1:SNO)
|
|---|
| 283 | ;
|
|---|
| 284 | S X="^XTMP("""_XTMP_""","_NO_"," D DOLRO^%ZOSV
|
|---|
| 285 | ;
|
|---|
| 286 | Q
|
|---|
| 287 | ;
|
|---|
| 288 | EOR ;HLEVUTI1 - Event Monitor UTILITIES ;5/16/03 14:42
|
|---|
