Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPDTU02

KMPDTU02.m

Go to the documentation of this file. 
  1. KMPDTU02 ;OAK/RAK - CP Tools Compile & File Daily Timing Stats ;2/17/04  09:43
  1.  ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1.  ;
  1. DAILY ;(KMPDST,KMPDEN);-entry point
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDST... Start date in internal fileman format.
  1.  ; KMPDEN... End date in internal fileman format.
  1.  ;
  1.  ; This API gathers Timing data from ^KMPTMP("KMPDT") and stores it in
  1.  ; file 8973.2 (CP TIMING)
  1.  ;
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  ;Q:'$G(KMPDST)
  1.  ;Q:'$G(KMPDEN)
  1.  ; make sure end date has hours
  1.  ;S:'$P(KMPDEN,".",2) $P(KMPDEN,".",2)="99"
  1.  ;S:'$G(DT) DT=$$DT^XLFDT
  1.  ;
  1.  W:'$D(ZTQUEUED) !,"Compiling Timing data..."
  1.  D COMPILE
  1.  ;
  1.  Q
  1.  ;
  1. COMPILE ;-- compile & file timing data
  1.  ;
  1.  Q:$O(^KMPTMP("KMPDT",""))=""
  1.  N COUNT,DATA,DATA1,ID,OK,SBSCR,TODAY
  1.  S TODAY=$P($H,",") Q:'TODAY
  1.  S SBSCR="",COUNT=0
  1.  F  S SBSCR=$O(^KMPTMP("KMPDT",SBSCR)) Q:SBSCR=""  S ID="" D 
  1.  .F  S ID=$O(^KMPTMP("KMPDT",SBSCR,ID)) Q:ID=""  S DATA=^(ID) D 
  1.  ..; quit if not 'previous' to DT
  1.  ..Q:$P($P(DATA,U),".")'<TODAY
  1.  ..; set up DATA1 for filing
  1.  ..; identifier
  1.  ..S $P(DATA1,U)=ID
  1.  ..; server start date/time in internal fileman format
  1.  ..S $P(DATA1,U,3)=$$HTFM^XLFDT($P(DATA,U))
  1.  ..; server delta
  1.  ..S:$P(DATA,U,2) $P(DATA1,U,4)=$$HDIFF^XLFDT($P(DATA,U,2),$P(DATA,U),2)
  1.  ..; person
  1.  ..S $P(DATA1,U,5)=$P(DATA,U,3)
  1.  ..; client name
  1.  ..S $P(DATA1,U,6)=$P(DATA,U,4)
  1.  ..; kmptmp subscript
  1.  ..S $P(DATA1,U,7)=SBSCR
  1.  ..; title
  1.  ..S $P(DATA1,U,8)=$$TITLEG(SBSCR)
  1.  ..; ip address
  1.  ..S $P(DATA1,U,9)=$P($P(ID,"-")," ",2)
  1.  ..; file data
  1.  ..D FILE(DATA1,.OK)
  1.  ..; update counter if successfully filed
  1.  ..S:OK COUNT=COUNT+1
  1.  ..; kill of old node if successfully filed
  1.  ..K:OK ^KMPTMP("KMPDT",SBSCR,ID)
  1.  ..I '$D(ZTQUEUED) W:'(COUNT#100) "."
  1.  ;
  1.  W:'$D(ZTQUEUED) !,COUNT," records filed!"
  1.  ;
  1.  Q
  1.  ;
  1. FILE(DATA,KMPDOK) ;-- file timing data into file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DATA.... Data to file in format:
  1.  ;          piece "^" 1 - id
  1.  ;                    3 - start date/time in internal fileman format
  1.  ;                    4 - delta
  1.  ;                    5 - new person
  1.  ;                    6 - client name
  1.  ;                    7 - kmptmp subscript
  1.  ;                    8 - title
  1.  ;                    9 - ip address
  1.  ;
  1.  ; KMPDOK.. Returned
  1.  ;            0 - not filed successfully
  1.  ;            1 - filed successfully
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  S KMPDOK=0
  1.  Q:$G(DATA)=""
  1.  ; id
  1.  Q:$P(DATA,U)=""
  1.  ; start date/time
  1.  Q:$P(DATA,U,3)=""
  1.  ;
  1.  N ERROR,FDA,I,IEN,ZIEN
  1.  ; build fda() array for filing
  1.  F I=1:1:9 I $P(DATA,U,I)'="" D 
  1.  .S FDA($J,8973.2,"+1,",(I*.01))=$P(DATA,U,I)
  1.  ; quit if no fda() array
  1.  Q:'$D(FDA($J))
  1.  ; file data
  1.  D UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
  1.  ; if error
  1.  I $D(ERROR) D MSG^DIALOG("HA",.ERROR,60,5,"ERROR") Q
  1.  S KMPDOK=1
  1.  ;
  1.  Q
  1.  ;
  1. TITLEG(SBSCR) ;-- extrinsic function - return title name
  1.  Q:$G(SBSCR)="" ""
  1.  N I,TITLE,X S TITLE=""
  1.  F I=1:1 S X=$T(TITLE+I) Q:X=""  I $P(X,";",3)=SBSCR S TITLE=$P(X,";",4) Q
  1.  Q TITLE
  1.  ;
  1. TITLE ;-- convert subscript to title
  1.  ;;ORWCV;CPRS Cover Sheet