KMPDU3 ;OAK/RAK - CM Tools Utilities ;7/22/04 09:10
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
ERRDATA(KMPDY,KMPDIEN,KMPDGBL) ;-- error log data.
;-----------------------------------------------------------------------
; KMPDIEN. Ien in format 'multiple,ien'.
; KMPDGBL... Global where data is stored.
;-----------------------------------------------------------------------
;
K KMPDY
;
I $G(KMPDIEN)="" S @KMPDGBL@(0)="[IEN not defined]" Q
;
I KMPDGBL="" S @KMPDGBL@(0)="[Global for storage is not defined]" Q
;
N DATA,DATA1,I,IEN,IEN1,LN
;
; kill global with check for ^tmp or ^utility.
D KILL^KMPDU(.DATA,KMPDGBL)
; if error.
I $E(DATA)="[" S @KMPDGBL@(0)=DATA Q
;
S IEN1=$P(KMPDIEN,",")
I 'IEN1 S @KMPDGBL@(0)="[IEN1 not defined]" Q
S IEN=$P(KMPDIEN,",",2)
I 'IEN S @KMPDGBL@(0)="[IEN not defined]" Q
;
S DATA=$G(^%ZTER(1,IEN,0))
I DATA="" S @KMPDGBL@(0)="[No data for "_KMPDIEN_"]" Q
;
; $h date in external format.
S @KMPDGBL@(0)=$$HTE^XLFDT($G(^%ZTER(1,IEN,1,IEN1,"H")))
; error text.
S @KMPDGBL@(1)=$G(^%ZTER(1,IEN,1,IEN1,"ZE"))
S @KMPDGBL@(2)="",LN=3
; last global reference.
I $G(^%ZTER(1,IEN,1,IEN1,"GR"))'="" D
.S @KMPDGBL@(LN)="Last Global Reference: "_^("GR"),LN=LN+1
; $h.
I $G(^%ZTER(1,IEN,1,IEN1,"H"))'="" D
.S @KMPDGBL@(LN)="$H: "_^("H"),LN=LN+1
S DATA=$G(^%ZTER(1,IEN,1,IEN1,"ECODE"))
; $ecode
S @KMPDGBL@(LN)="$ECODE = "_$P(DATA,U),LN=LN+1
; $stack
S @KMPDGBL@(LN)="$STACK = "_$P(DATA,U,2),LN=LN+1
; $estack
S @KMPDGBL@(LN)="$ESTACK = "_$P(DATA,U,3),LN=LN+1
; $quit
S @KMPDGBL@(LN)="$QUIT = "_$P(DATA,U,4),LN=LN+1
; $stack multiple.
F I=0:0 S I=$O(^%ZTER(1,IEN,1,IEN1,"STACK",I)) Q:'I D
.Q:'$D(^%ZTER(1,IEN,1,IEN1,"STACK",I,0)) S DATA=^(0)
.S @KMPDGBL@(LN)=$P(DATA,U)_" = "_$P(DATA,U,2)
.S LN=LN+1
; variables and data multiple #10.
F I=0:0 S I=$O(^%ZTER(1,IEN,1,IEN1,"ZV",I)) Q:'I D
.Q:'$D(^%ZTER(1,IEN,1,IEN1,"ZV",I,0)) S DATA=^(0),DATA1=$G(^("D"))
.Q:DATA=""
.S @KMPDGBL@(LN)=DATA_" = "_$E(DATA1,1,225)
.S LN=LN+1
;
S KMPDY=$NA(@KMPDGBL)
S:'$D(@KMPDGBL) KMPDY="<No Data To Report>"
;
Q
;
ERRDATE(KMPDY,KMPDATE) ;-- get error log date or list all dates
;-----------------------------------------------------------------------
; KMPDATE... Date in internal fileman format, or "*" for a list of all
; available dates.
;
; if one date
; KMPDY(0)=ExternalDate^Ien^NumberOfErrors
;
; or a list of all available dates
; KMPDY(0)=ExternalDate^Ien^NumberOfErrors
; KMPDY(1)=ExternalDate^Ien^NumberOfErrors
; KMPDY(2)=ExternalDate^Ien^NumberOfErrors
; KMPDY(...)=...
;-----------------------------------------------------------------------
;
I $G(KMPDATE)="" S KMPDY(0)="[Date entry not defined]" Q
;
I KMPDATE'="*" D Q
.; external date
.S $P(KMPDY(0),U)=$$FMTE^XLFDT(KMPDATE)
.; set to date portion of $h format
.S KMPDATE=+$$FMTH^XLFDT(KMPDATE)
.; ien
.S $P(KMPDY(0),U,2)=$O(^%ZTER(1,"B",KMPDATE,0))
.; number of errors
.S $P(KMPDY(0),U,3)=$P($G(^%ZTER(1,+$P(KMPDY(0),U,2),1,0)),U,3)
;
; if all entries requested
I KMPDATE="*" D Q
.N DATE,I,LN S (I,LN)=0
.F S I=$O(^%ZTER(1,"B",I)) Q:'I I $D(^%ZTER(1,I,0)) D
..; external date
..S $P(KMPDY(LN),U)=$$HTE^XLFDT(I)
..; ien
..S $P(KMPDY(LN),U,2)=I
..; number of errors
..S $P(KMPDY(LN),U,3)=$P($G(^%ZTER(1,I,1,0)),U,3)
..S LN=LN+1
;
Q
;
ERRLIST(KMPDRES,KMPDTH,KMPDSCRN,KMPDGBL) ;
;----------------------------------------------------------------------
; KMPDT.... $H date.
; KMPDSCRN. (optional) free text screen for certain error
;----------------------------------------------------------------------
K KMPDRES
S KMPDTH=+$G(KMPDTH),KMPDSCRN=$G(KMPDSCRN),KMPDGBL=$G(KMPDGBL)
;
N DATA,I,LN
;
; kill global with check for ^tmp or ^utility.
D KILL^KMPDU(.DATA,KMPDGBL)
; if error.
I $E(DATA)="[" S @KMPDGBL@(0)=DATA Q
;
I 'KMPDTH S @KMPDGBL@(0)="[The Error Date is not defined]" Q
I '$D(^%ZTER(1,KMPDTH,0)) S @KMPDGBL@(0)="[There is no data to report]" Q
I KMPDGBL="" S @KMPDGBL@(0)="[Global for storage is not defined]" Q
;
S (I,LN)=0,KMPDRES(0)=KMPDGBL
F S I=$O(^%ZTER(1,KMPDTH,1,I)) Q:'I I $D(^(I,0)) D
.I KMPDSCRN'="" X KMPDSCRN Q:'$T
.S @KMPDGBL@(LN)=I
.S $P(@KMPDGBL@(LN),U,2)=$P($G(^%ZTER(1,KMPDTH,1,I,"ZE")),U)
.S $P(@KMPDGBL@(LN),U,3)=$P($$HTE^XLFDT($P($G(^%ZTER(1,KMPDTH,1,I,"H")),U)),"@",2)
.S LN=LN+1
;
S KMPDRES=$NA(@KMPDGBL)
I '$D(@KMPDGBL) S @KMPDGBL@(0)="[There are no Errors for this date]" Q
;
Q
;
ROUSAVE(KMPDRES,KMPDRNM,KMPDRCD) ;-- routine save
;-----------------------------------------------------------------------
; KMPDRNM... Routine name.
; KMPDRCD... Array contianing routine code (or text).
;-----------------------------------------------------------------------
;
K KMPDRES
I $G(KMPDRNM)="" S KMPDRES(0)="[Routine Name not defined]" Q
I $L(KMPDRNM)>8 D Q
.S KMPDRES(0)="[Routine Name must not be greater than 8 characters]"
I '$D(KMPDRCD) D Q
.S KMPDRES(0)="[There is no Routine code (text) to save]"
;
N DIE,GLOBAL,I,X,XCN
S GLOBAL=$NA(^TMP("KMPDU3-1",$J))
K @GLOBAL
S I=0
F S I=$O(KMPDRCD(I)) Q:'I S @GLOBAL@(I,0)=KMPDRCD(I)
S X=KMPDRNM,DIE="^TMP("_"""KMPDU3-1"""_","_$J_",",XCN=0
X ^%ZOSF("SAVE")
;
S KMPDRES(0)="<Routine Saved>"
;
Q
;
ROUSTATS(KMPDRES,KMPDIENS) ;-- routine stats
;-----------------------------------------------------------------------
; KMPDIENS... Ien(s) for file #8972.1 (CAPMAN ROUTINE STATS). If more
; than one Ien then each will be seperated by a comma.
; Example: KMPDIENS="12,98,38,123"
;
; KMPDRES() Results up-arrow (^) delimited in format:
; Piece 1 - Name..................(field .01)
; Piece 4 - CPU Time..............(field #.04)
; Piece 5 - DIO References........(field #.05)
; Piece 6 - BIO References........(field #.06)
; Piece 7 - Page Faults...........(field #.07)
; Piece 8 - M commands/Lines......(field #.08)
; Piece 9 - Global References.....(field #.09)
; Piece 10 - Count.................(field #.1)
; Piece 14 - Ave CPU Time..........(field #99.04 - computed)
; Piece 15 - Ave DIO References....(field #99.05 - computed)
; Piece 16 - Ave BIO References....(field #99.06 - computed)
; Piece 17 - Ave Page Faults.......(field #99.07 - computed)
; Piece 18 - Ave M Commands/Lines..(field #99.08 - computed)
; Piece 19 - Ave Global References.(field #99.09 - computed)
;-----------------------------------------------------------------------
;
K KMPDRES
I $G(KMPDIENS)="" S KMPDRES(0)="[IEN data not defined]" Q
;
N DATA,I,IEN,J,LN
;
S IEN="",(I,LN)=0
F I=1:1 S IEN=$P(KMPDIENS,",",I) Q:'IEN D
.Q:'$D(^KMPD(8972.1,IEN,0)) S DATA=^(0)
.; put second piece (date/time entered) in external format
.S $P(DATA,U,2)=$$FMTE^XLFDT($P(DATA,U,2))
.; make sure there are no null values
.F J=4:1:10,12 S $P(DATA,U,J)=+($P(DATA,U,J))
.S KMPDRES(LN)=DATA
.; computed fields
.F J=4:1:9 S $P(KMPDRES(LN),U,(J+10))=+$$GET1^DIQ(8972.1,IEN,(99+(.01*J)))
.S LN=LN+1
;
S:'$D(KMPDRES) KMPDRES(0)="<No Data to Report>"
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDU3 7392 printed Apr 09, 2024@20:47:10 Page 2
KMPDU3 ;OAK/RAK - CM Tools Utilities ;7/22/04 09:10
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
ERRDATA(KMPDY,KMPDIEN,KMPDGBL) ;-- error log data.
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIEN. Ien in format 'multiple,ien'.
+3 ; KMPDGBL... Global where data is stored.
+4 ;-----------------------------------------------------------------------
+5 ;
+6 KILL KMPDY
+7 ;
+8 IF $GET(KMPDIEN)=""
SET @KMPDGBL@(0)="[IEN not defined]"
QUIT
+9 ;
+10 IF KMPDGBL=""
SET @KMPDGBL@(0)="[Global for storage is not defined]"
QUIT
+11 ;
+12 NEW DATA,DATA1,I,IEN,IEN1,LN
+13 ;
+14 ; kill global with check for ^tmp or ^utility.
+15 DO KILL^KMPDU(.DATA,KMPDGBL)
+16 ; if error.
+17 IF $EXTRACT(DATA)="["
SET @KMPDGBL@(0)=DATA
QUIT
+18 ;
+19 SET IEN1=$PIECE(KMPDIEN,",")
+20 IF 'IEN1
SET @KMPDGBL@(0)="[IEN1 not defined]"
QUIT
+21 SET IEN=$PIECE(KMPDIEN,",",2)
+22 IF 'IEN
SET @KMPDGBL@(0)="[IEN not defined]"
QUIT
+23 ;
+24 SET DATA=$GET(^%ZTER(1,IEN,0))
+25 IF DATA=""
SET @KMPDGBL@(0)="[No data for "_KMPDIEN_"]"
QUIT
+26 ;
+27 ; $h date in external format.
+28 SET @KMPDGBL@(0)=$$HTE^XLFDT($GET(^%ZTER(1,IEN,1,IEN1,"H")))
+29 ; error text.
+30 SET @KMPDGBL@(1)=$GET(^%ZTER(1,IEN,1,IEN1,"ZE"))
+31 SET @KMPDGBL@(2)=""
SET LN=3
+32 ; last global reference.
+33 IF $GET(^%ZTER(1,IEN,1,IEN1,"GR"))'=""
Begin DoDot:1
+34 SET @KMPDGBL@(LN)="Last Global Reference: "_^("GR")
SET LN=LN+1
End DoDot:1
+35 ; $h.
+36 IF $GET(^%ZTER(1,IEN,1,IEN1,"H"))'=""
Begin DoDot:1
+37 SET @KMPDGBL@(LN)="$H: "_^("H")
SET LN=LN+1
End DoDot:1
+38 SET DATA=$GET(^%ZTER(1,IEN,1,IEN1,"ECODE"))
+39 ; $ecode
+40 SET @KMPDGBL@(LN)="$ECODE = "_$PIECE(DATA,U)
SET LN=LN+1
+41 ; $stack
+42 SET @KMPDGBL@(LN)="$STACK = "_$PIECE(DATA,U,2)
SET LN=LN+1
+43 ; $estack
+44 SET @KMPDGBL@(LN)="$ESTACK = "_$PIECE(DATA,U,3)
SET LN=LN+1
+45 ; $quit
+46 SET @KMPDGBL@(LN)="$QUIT = "_$PIECE(DATA,U,4)
SET LN=LN+1
+47 ; $stack multiple.
+48 FOR I=0:0
SET I=$ORDER(^%ZTER(1,IEN,1,IEN1,"STACK",I))
if 'I
QUIT
Begin DoDot:1
+49 if '$DATA(^%ZTER(1,IEN,1,IEN1,"STACK",I,0))
QUIT
SET DATA=^(0)
+50 SET @KMPDGBL@(LN)=$PIECE(DATA,U)_" = "_$PIECE(DATA,U,2)
+51 SET LN=LN+1
End DoDot:1
+52 ; variables and data multiple #10.
+53 FOR I=0:0
SET I=$ORDER(^%ZTER(1,IEN,1,IEN1,"ZV",I))
if 'I
QUIT
Begin DoDot:1
+54 if '$DATA(^%ZTER(1,IEN,1,IEN1,"ZV",I,0))
QUIT
SET DATA=^(0)
SET DATA1=$GET(^("D"))
+55 if DATA=""
QUIT
+56 SET @KMPDGBL@(LN)=DATA_" = "_$EXTRACT(DATA1,1,225)
+57 SET LN=LN+1
End DoDot:1
+58 ;
+59 SET KMPDY=$NAME(@KMPDGBL)
+60 if '$DATA(@KMPDGBL)
SET KMPDY="<No Data To Report>"
+61 ;
+62 QUIT
+63 ;
ERRDATE(KMPDY,KMPDATE) ;-- get error log date or list all dates
+1 ;-----------------------------------------------------------------------
+2 ; KMPDATE... Date in internal fileman format, or "*" for a list of all
+3 ; available dates.
+4 ;
+5 ; if one date
+6 ; KMPDY(0)=ExternalDate^Ien^NumberOfErrors
+7 ;
+8 ; or a list of all available dates
+9 ; KMPDY(0)=ExternalDate^Ien^NumberOfErrors
+10 ; KMPDY(1)=ExternalDate^Ien^NumberOfErrors
+11 ; KMPDY(2)=ExternalDate^Ien^NumberOfErrors
+12 ; KMPDY(...)=...
+13 ;-----------------------------------------------------------------------
+14 ;
+15 IF $GET(KMPDATE)=""
SET KMPDY(0)="[Date entry not defined]"
QUIT
+16 ;
+17 IF KMPDATE'="*"
Begin DoDot:1
+18 ; external date
+19 SET $PIECE(KMPDY(0),U)=$$FMTE^XLFDT(KMPDATE)
+20 ; set to date portion of $h format
+21 SET KMPDATE=+$$FMTH^XLFDT(KMPDATE)
+22 ; ien
+23 SET $PIECE(KMPDY(0),U,2)=$ORDER(^%ZTER(1,"B",KMPDATE,0))
+24 ; number of errors
+25 SET $PIECE(KMPDY(0),U,3)=$PIECE($GET(^%ZTER(1,+$PIECE(KMPDY(0),U,2),1,0)),U,3)
End DoDot:1
QUIT
+26 ;
+27 ; if all entries requested
+28 IF KMPDATE="*"
Begin DoDot:1
+29 NEW DATE,I,LN
SET (I,LN)=0
+30 FOR
SET I=$ORDER(^%ZTER(1,"B",I))
if 'I
QUIT
IF $DATA(^%ZTER(1,I,0))
Begin DoDot:2
+31 ; external date
+32 SET $PIECE(KMPDY(LN),U)=$$HTE^XLFDT(I)
+33 ; ien
+34 SET $PIECE(KMPDY(LN),U,2)=I
+35 ; number of errors
+36 SET $PIECE(KMPDY(LN),U,3)=$PIECE($GET(^%ZTER(1,I,1,0)),U,3)
+37 SET LN=LN+1
End DoDot:2
End DoDot:1
QUIT
+38 ;
+39 QUIT
+40 ;
ERRLIST(KMPDRES,KMPDTH,KMPDSCRN,KMPDGBL) ;
+1 ;----------------------------------------------------------------------
+2 ; KMPDT.... $H date.
+3 ; KMPDSCRN. (optional) free text screen for certain error
+4 ;----------------------------------------------------------------------
+5 KILL KMPDRES
+6 SET KMPDTH=+$GET(KMPDTH)
SET KMPDSCRN=$GET(KMPDSCRN)
SET KMPDGBL=$GET(KMPDGBL)
+7 ;
+8 NEW DATA,I,LN
+9 ;
+10 ; kill global with check for ^tmp or ^utility.
+11 DO KILL^KMPDU(.DATA,KMPDGBL)
+12 ; if error.
+13 IF $EXTRACT(DATA)="["
SET @KMPDGBL@(0)=DATA
QUIT
+14 ;
+15 IF 'KMPDTH
SET @KMPDGBL@(0)="[The Error Date is not defined]"
QUIT
+16 IF '$DATA(^%ZTER(1,KMPDTH,0))
SET @KMPDGBL@(0)="[There is no data to report]"
QUIT
+17 IF KMPDGBL=""
SET @KMPDGBL@(0)="[Global for storage is not defined]"
QUIT
+18 ;
+19 SET (I,LN)=0
SET KMPDRES(0)=KMPDGBL
+20 FOR
SET I=$ORDER(^%ZTER(1,KMPDTH,1,I))
if 'I
QUIT
IF $DATA(^(I,0))
Begin DoDot:1
+21 IF KMPDSCRN'=""
XECUTE KMPDSCRN
if '$TEST
QUIT
+22 SET @KMPDGBL@(LN)=I
+23 SET $PIECE(@KMPDGBL@(LN),U,2)=$PIECE($GET(^%ZTER(1,KMPDTH,1,I,"ZE")),U)
+24 SET $PIECE(@KMPDGBL@(LN),U,3)=$PIECE($$HTE^XLFDT($PIECE($GET(^%ZTER(1,KMPDTH,1,I,"H")),U)),"@",2)
+25 SET LN=LN+1
End DoDot:1
+26 ;
+27 SET KMPDRES=$NAME(@KMPDGBL)
+28 IF '$DATA(@KMPDGBL)
SET @KMPDGBL@(0)="[There are no Errors for this date]"
QUIT
+29 ;
+30 QUIT
+31 ;
ROUSAVE(KMPDRES,KMPDRNM,KMPDRCD) ;-- routine save
+1 ;-----------------------------------------------------------------------
+2 ; KMPDRNM... Routine name.
+3 ; KMPDRCD... Array contianing routine code (or text).
+4 ;-----------------------------------------------------------------------
+5 ;
+6 KILL KMPDRES
+7 IF $GET(KMPDRNM)=""
SET KMPDRES(0)="[Routine Name not defined]"
QUIT
+8 IF $LENGTH(KMPDRNM)>8
Begin DoDot:1
+9 SET KMPDRES(0)="[Routine Name must not be greater than 8 characters]"
End DoDot:1
QUIT
+10 IF '$DATA(KMPDRCD)
Begin DoDot:1
+11 SET KMPDRES(0)="[There is no Routine code (text) to save]"
End DoDot:1
QUIT
+12 ;
+13 NEW DIE,GLOBAL,I,X,XCN
+14 SET GLOBAL=$NAME(^TMP("KMPDU3-1",$JOB))
+15 KILL @GLOBAL
+16 SET I=0
+17 FOR
SET I=$ORDER(KMPDRCD(I))
if 'I
QUIT
SET @GLOBAL@(I,0)=KMPDRCD(I)
+18 SET X=KMPDRNM
SET DIE="^TMP("_"""KMPDU3-1"""_","_$JOB_","
SET XCN=0
+19 XECUTE ^%ZOSF("SAVE")
+20 ;
+21 SET KMPDRES(0)="<Routine Saved>"
+22 ;
+23 QUIT
+24 ;
ROUSTATS(KMPDRES,KMPDIENS) ;-- routine stats
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIENS... Ien(s) for file #8972.1 (CAPMAN ROUTINE STATS). If more
+3 ; than one Ien then each will be seperated by a comma.
+4 ; Example: KMPDIENS="12,98,38,123"
+5 ;
+6 ; KMPDRES() Results up-arrow (^) delimited in format:
+7 ; Piece 1 - Name..................(field .01)
+8 ; Piece 4 - CPU Time..............(field #.04)
+9 ; Piece 5 - DIO References........(field #.05)
+10 ; Piece 6 - BIO References........(field #.06)
+11 ; Piece 7 - Page Faults...........(field #.07)
+12 ; Piece 8 - M commands/Lines......(field #.08)
+13 ; Piece 9 - Global References.....(field #.09)
+14 ; Piece 10 - Count.................(field #.1)
+15 ; Piece 14 - Ave CPU Time..........(field #99.04 - computed)
+16 ; Piece 15 - Ave DIO References....(field #99.05 - computed)
+17 ; Piece 16 - Ave BIO References....(field #99.06 - computed)
+18 ; Piece 17 - Ave Page Faults.......(field #99.07 - computed)
+19 ; Piece 18 - Ave M Commands/Lines..(field #99.08 - computed)
+20 ; Piece 19 - Ave Global References.(field #99.09 - computed)
+21 ;-----------------------------------------------------------------------
+22 ;
+23 KILL KMPDRES
+24 IF $GET(KMPDIENS)=""
SET KMPDRES(0)="[IEN data not defined]"
QUIT
+25 ;
+26 NEW DATA,I,IEN,J,LN
+27 ;
+28 SET IEN=""
SET (I,LN)=0
+29 FOR I=1:1
SET IEN=$PIECE(KMPDIENS,",",I)
if 'IEN
QUIT
Begin DoDot:1
+30 if '$DATA(^KMPD(8972.1,IEN,0))
QUIT
SET DATA=^(0)
+31 ; put second piece (date/time entered) in external format
+32 SET $PIECE(DATA,U,2)=$$FMTE^XLFDT($PIECE(DATA,U,2))
+33 ; make sure there are no null values
+34 FOR J=4:1:10,12
SET $PIECE(DATA,U,J)=+($PIECE(DATA,U,J))
+35 SET KMPDRES(LN)=DATA
+36 ; computed fields
+37 FOR J=4:1:9
SET $PIECE(KMPDRES(LN),U,(J+10))=+$$GET1^DIQ(8972.1,IEN,(99+(.01*J)))
+38 SET LN=LN+1
End DoDot:1
+39 ;
+40 if '$DATA(KMPDRES)
SET KMPDRES(0)="<No Data to Report>"
+41 ;
+42 QUIT
