KMPDTU02 ;OAK/RAK - CP Tools Compile & File Daily Timing Stats ;2/17/04 09:43
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
DAILY ;(KMPDST,KMPDEN);-entry point
;-----------------------------------------------------------------------
; KMPDST... Start date in internal fileman format.
; KMPDEN... End date in internal fileman format.
;
; This API gathers Timing data from ^KMPTMP("KMPDT") and stores it in
; file 8973.2 (CP TIMING)
;
;-----------------------------------------------------------------------
;
;Q:'$G(KMPDST)
;Q:'$G(KMPDEN)
; make sure end date has hours
;S:'$P(KMPDEN,".",2) $P(KMPDEN,".",2)="99"
;S:'$G(DT) DT=$$DT^XLFDT
;
W:'$D(ZTQUEUED) !,"Compiling Timing data..."
D COMPILE
;
Q
;
COMPILE ;-- compile & file timing data
;
Q:$O(^KMPTMP("KMPDT",""))=""
N COUNT,DATA,DATA1,ID,OK,SBSCR,TODAY
S TODAY=$P($H,",") Q:'TODAY
S SBSCR="",COUNT=0
F S SBSCR=$O(^KMPTMP("KMPDT",SBSCR)) Q:SBSCR="" S ID="" D
.F S ID=$O(^KMPTMP("KMPDT",SBSCR,ID)) Q:ID="" S DATA=^(ID) D
..; quit if not 'previous' to DT
..Q:$P($P(DATA,U),".")'<TODAY
..; set up DATA1 for filing
..; identifier
..S $P(DATA1,U)=ID
..; server start date/time in internal fileman format
..S $P(DATA1,U,3)=$$HTFM^XLFDT($P(DATA,U))
..; server delta
..S:$P(DATA,U,2) $P(DATA1,U,4)=$$HDIFF^XLFDT($P(DATA,U,2),$P(DATA,U),2)
..; person
..S $P(DATA1,U,5)=$P(DATA,U,3)
..; client name
..S $P(DATA1,U,6)=$P(DATA,U,4)
..; kmptmp subscript
..S $P(DATA1,U,7)=SBSCR
..; title
..S $P(DATA1,U,8)=$$TITLEG(SBSCR)
..; ip address
..S $P(DATA1,U,9)=$P($P(ID,"-")," ",2)
..; file data
..D FILE(DATA1,.OK)
..; update counter if successfully filed
..S:OK COUNT=COUNT+1
..; kill of old node if successfully filed
..K:OK ^KMPTMP("KMPDT",SBSCR,ID)
..I '$D(ZTQUEUED) W:'(COUNT#100) "."
;
W:'$D(ZTQUEUED) !,COUNT," records filed!"
;
Q
;
FILE(DATA,KMPDOK) ;-- file timing data into file #8973.2
;-----------------------------------------------------------------------
; DATA.... Data to file in format:
; piece "^" 1 - id
; 3 - start date/time in internal fileman format
; 4 - delta
; 5 - new person
; 6 - client name
; 7 - kmptmp subscript
; 8 - title
; 9 - ip address
;
; KMPDOK.. Returned
; 0 - not filed successfully
; 1 - filed successfully
;-----------------------------------------------------------------------
;
S KMPDOK=0
Q:$G(DATA)=""
; id
Q:$P(DATA,U)=""
; start date/time
Q:$P(DATA,U,3)=""
;
N ERROR,FDA,I,IEN,ZIEN
; build fda() array for filing
F I=1:1:9 I $P(DATA,U,I)'="" D
.S FDA($J,8973.2,"+1,",(I*.01))=$P(DATA,U,I)
; quit if no fda() array
Q:'$D(FDA($J))
; file data
D UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
; if error
I $D(ERROR) D MSG^DIALOG("HA",.ERROR,60,5,"ERROR") Q
S KMPDOK=1
;
Q
;
TITLEG(SBSCR) ;-- extrinsic function - return title name
Q:$G(SBSCR)="" ""
N I,TITLE,X S TITLE=""
F I=1:1 S X=$T(TITLE+I) Q:X="" I $P(X,";",3)=SBSCR S TITLE=$P(X,";",4) Q
Q TITLE
;
TITLE ;-- convert subscript to title
;;ORWCV;CPRS Cover Sheet
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDTU02 3265 printed Apr 09, 2024@20:46:55 Page 2
KMPDTU02 ;OAK/RAK - CP Tools Compile & File Daily Timing Stats ;2/17/04 09:43
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
DAILY ;(KMPDST,KMPDEN);-entry point
+1 ;-----------------------------------------------------------------------
+2 ; KMPDST... Start date in internal fileman format.
+3 ; KMPDEN... End date in internal fileman format.
+4 ;
+5 ; This API gathers Timing data from ^KMPTMP("KMPDT") and stores it in
+6 ; file 8973.2 (CP TIMING)
+7 ;
+8 ;-----------------------------------------------------------------------
+9 ;
+10 ;Q:'$G(KMPDST)
+11 ;Q:'$G(KMPDEN)
+12 ; make sure end date has hours
+13 ;S:'$P(KMPDEN,".",2) $P(KMPDEN,".",2)="99"
+14 ;S:'$G(DT) DT=$$DT^XLFDT
+15 ;
+16 if '$DATA(ZTQUEUED)
WRITE !,"Compiling Timing data..."
+17 DO COMPILE
+18 ;
+19 QUIT
+20 ;
COMPILE ;-- compile & file timing data
+1 ;
+2 if $ORDER(^KMPTMP("KMPDT",""))=""
QUIT
+3 NEW COUNT,DATA,DATA1,ID,OK,SBSCR,TODAY
+4 SET TODAY=$PIECE($HOROLOG,",")
if 'TODAY
QUIT
+5 SET SBSCR=""
SET COUNT=0
+6 FOR
SET SBSCR=$ORDER(^KMPTMP("KMPDT",SBSCR))
if SBSCR=""
QUIT
SET ID=""
Begin DoDot:1
+7 FOR
SET ID=$ORDER(^KMPTMP("KMPDT",SBSCR,ID))
if ID=""
QUIT
SET DATA=^(ID)
Begin DoDot:2
+8 ; quit if not 'previous' to DT
+9 if $PIECE($PIECE(DATA,U),".")'<TODAY
QUIT
+10 ; set up DATA1 for filing
+11 ; identifier
+12 SET $PIECE(DATA1,U)=ID
+13 ; server start date/time in internal fileman format
+14 SET $PIECE(DATA1,U,3)=$$HTFM^XLFDT($PIECE(DATA,U))
+15 ; server delta
+16 if $PIECE(DATA,U,2)
SET $PIECE(DATA1,U,4)=$$HDIFF^XLFDT($PIECE(DATA,U,2),$PIECE(DATA,U),2)
+17 ; person
+18 SET $PIECE(DATA1,U,5)=$PIECE(DATA,U,3)
+19 ; client name
+20 SET $PIECE(DATA1,U,6)=$PIECE(DATA,U,4)
+21 ; kmptmp subscript
+22 SET $PIECE(DATA1,U,7)=SBSCR
+23 ; title
+24 SET $PIECE(DATA1,U,8)=$$TITLEG(SBSCR)
+25 ; ip address
+26 SET $PIECE(DATA1,U,9)=$PIECE($PIECE(ID,"-")," ",2)
+27 ; file data
+28 DO FILE(DATA1,.OK)
+29 ; update counter if successfully filed
+30 if OK
SET COUNT=COUNT+1
+31 ; kill of old node if successfully filed
+32 if OK
KILL ^KMPTMP("KMPDT",SBSCR,ID)
+33 IF '$DATA(ZTQUEUED)
if '(COUNT#100)
WRITE "."
End DoDot:2
End DoDot:1
+34 ;
+35 if '$DATA(ZTQUEUED)
WRITE !,COUNT," records filed!"
+36 ;
+37 QUIT
+38 ;
FILE(DATA,KMPDOK) ;-- file timing data into file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DATA.... Data to file in format:
+3 ; piece "^" 1 - id
+4 ; 3 - start date/time in internal fileman format
+5 ; 4 - delta
+6 ; 5 - new person
+7 ; 6 - client name
+8 ; 7 - kmptmp subscript
+9 ; 8 - title
+10 ; 9 - ip address
+11 ;
+12 ; KMPDOK.. Returned
+13 ; 0 - not filed successfully
+14 ; 1 - filed successfully
+15 ;-----------------------------------------------------------------------
+16 ;
+17 SET KMPDOK=0
+18 if $GET(DATA)=""
QUIT
+19 ; id
+20 if $PIECE(DATA,U)=""
QUIT
+21 ; start date/time
+22 if $PIECE(DATA,U,3)=""
QUIT
+23 ;
+24 NEW ERROR,FDA,I,IEN,ZIEN
+25 ; build fda() array for filing
+26 FOR I=1:1:9
IF $PIECE(DATA,U,I)'=""
Begin DoDot:1
+27 SET FDA($JOB,8973.2,"+1,",(I*.01))=$PIECE(DATA,U,I)
End DoDot:1
+28 ; quit if no fda() array
+29 if '$DATA(FDA($JOB))
QUIT
+30 ; file data
+31 DO UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
+32 ; if error
+33 IF $DATA(ERROR)
DO MSG^DIALOG("HA",.ERROR,60,5,"ERROR")
QUIT
+34 SET KMPDOK=1
+35 ;
+36 QUIT
+37 ;
TITLEG(SBSCR) ;-- extrinsic function - return title name
+1 if $GET(SBSCR)=""
QUIT ""
+2 NEW I,TITLE,X
SET TITLE=""
+3 FOR I=1:1
SET X=$TEXT(TITLE+I)
if X=""
QUIT
IF $PIECE(X,";",3)=SBSCR
SET TITLE=$PIECE(X,";",4)
QUIT
+4 QUIT TITLE
+5 ;
TITLE ;-- convert subscript to title
+1 ;;ORWCV;CPRS Cover Sheet
