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

KMPDHU01.m

Go to the documentation of this file. 
  1. KMPDHU01 ;OAK/RAK - CM Tools HL7 Utility ;6/21/05  10:12
  1.  ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1.  ;
  1. WEEKLY(KMPDT,KMPDPRGE) ;-- compress daily stats to weekly
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDT.... Compression date in internal fileman formt.  This date
  1.  ;           must be a Sunday.  It represents the date from which the
  1.  ;           previous weeks data should be compressed. 
  1.  ;           Example: if KMPDT = 2981011  then compression will begin
  1.  ;                    on 2981010 (KMPDT-1)
  1.  ; KMPDPRGE. 0 - do not purge data from file #8973.1
  1.  ;           1 - purge data from file #8973.1
  1.  ;
  1.  ; Every Sunday compress the daily stats in file #8973.1 into weekly
  1.  ; and upload the data to the CM RUM National Database
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  Q:'$G(KMPDT)
  1.  S KMPDPRGE=+$G(KMPDPRGE)
  1.  ;
  1.  N DATA,DATE,DDLDT,DELDATE,EN,END,HOURS,I,IEN,J,NM,PT,SITE,STR,START,SYNC
  1.  ;
  1.  ; quit if not sunday.
  1.  Q:$$DOW^XLFDT(KMPDT,1)
  1.  ; storage  processed
  1.  K ^TMP($J),^TMP("KMPDHU01",$J)
  1.  ; site info.
  1.  S SITE=$$SITE^VASITE Q:SITE=""
  1.  S DATE=KMPDT
  1.  S (START,END)="",STR=$$NOW^XLFDT
  1.  ; days to keep - this is represented by 'weeks to keep' in file #8973 
  1.  ; so must be converted to days
  1.  S DDLDT=$P($G(^KMPD(8973,1,3)),U,11)*7
  1.  S:'DDLDT DDLDT=14
  1.  ; Date to begin deletion.
  1.  S DELDATE=$$FMADD^XLFDT(KMPDT,-DDLDT)
  1.  ;
  1.  W:'$D(ZTQUEUED) !,"Compressing data into weekly format..."
  1.  ; Reverse $order to get previous dates.
  1.  F  S DATE=$O(^KMPD(8973.1,"B",DATE),-1) Q:'DATE  D 
  1.  .; If DATE is saturday set START and END dates and kill TMPARRY.
  1.  .I $$DOW^XLFDT(DATE,1)=6 D 
  1.  ..S END=DATE,START=$$FMADD^XLFDT(DATE,-6)
  1.  ..K ^TMP($J)
  1.  .Q:'START
  1.  .S SYNC=0
  1.  .F  S SYNC=$O(^KMPD(8973.1,"ASYNC",DATE,SYNC)) Q:'SYNC  S IEN=0 D 
  1.  ..F  S IEN=$O(^KMPD(8973.1,"ASYNC",DATE,SYNC,IEN)) Q:'IEN  D 
  1.  ...Q:'$D(^KMPD(8973.1,IEN,0))
  1.  ...; data nodes into DATA() array.
  1.  ...S DATA(0)=^KMPD(8973.1,IEN,0) F I=1,1.1,1.2,2,2.1,2.2,5.1:.1:5.5,5.7,5.8,5.9,99,99.2,99.3,99.5 S DATA(I)=$G(^(I))
  1.  ...; quit if data has already been sent to national database
  1.  ...Q:$P(DATA(0),U,2)
  1.  ...; quit if no namespace or protocol
  1.  ...S NM=$P(DATA(0),U,3),PT=$P(DATA(0),U,5) Q:NM=""!(PT="")
  1.  ...; change first piece to start date (this is for national database)
  1.  ...S $P(DATA(0),U)=START
  1.  ...; second piece not applicable to national database
  1.  ...S $P(DATA(0),U,2)=""
  1.  ...D @$S(SYNC=2:"ASYNC(IEN,NM,PT,.DATA)",1:"SYNC(IEN,NM,PT,.DATA)")
  1.  ...; add to processed array.
  1.  ...S ^TMP("KMPDHU01",$J,IEN)=""
  1.  .;
  1.  .; Back to DATE level.
  1.  .; If START then transmit data.
  1.  .I DATE=START I $D(^TMP($J)) D TRANSMIT K ^TMP($J)
  1.  ;
  1.  D:$D(^TMP($J)) TRANSMIT
  1.  K ^TMP($J)
  1.  ;
  1.  ; update field .02 (SENT TO CM NATIONAL DATABASE) to 'YES' for all
  1.  ; processed entries.
  1.  W:'$D(ZTQUEUED) !!,"Updating records to reflect transmission..."
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("KMPDHU01",$J,IEN)) Q:'IEN  D 
  1.  .K FDA,ERROR W:'$D(ZTQUEUED) "."
  1.  .S FDA($J,8973.1,IEN_",",.02)=1
  1.  .D FILE^DIE("","FDA($J)","ERROR")
  1.  ;
  1.  K ^TMP("KMPDHU01",$J)
  1.  ;
  1.  S STR=$$NOW^XLFDT
  1.  ; leave two complete weeks of data in file #8973.1
  1.  D:KMPDPRGE PURGE^KMPDUTL3(DELDATE)
  1.  D STRSTP^KMPDUTL2(3,2,2,STR)
  1.  ;
  1.  W:'$D(ZTQUEUED) !!,"Finished!"
  1.  ;
  1.  Q
  1.  ;
  1. ASYNC(IEN,NM,PR,DATA) ; compile asynchronous stats
  1.  ;-----------------------------------------------------------------------
  1.  ; IEN..... Ien for file #8973.1 (CM HL7 DATA)
  1.  ; NM...... Namespace (free text)
  1.  ; PR...... Protocol (free text)
  1.  ; DATA().. Array containing node data for file #8973.1 (CM HL7 DATA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(IEN)
  1.  Q:$G(NM)=""
  1.  Q:$G(PR)=""
  1.  Q:'$D(DATA)
  1.  N CS,I,J
  1.  ; quit if no contact site
  1.  S CS=$P(DATA(99.2),U,12) Q:CS=""
  1.  S ^TMP($J,START,NM,PR,CS,0)=DATA(0)
  1.  ; node 99.1 is for national database (end date^facility name)
  1.  S DATA(99.1)=END_"^"_$P(SITE,U,2)_"^"_$P(SITE,U,3)
  1.  ; pieces 6 through 13 of node 99.2 contain text
  1.  F I=6:1:13 S $P(^TMP($J,START,NM,PR,CS,99.2),U,I)=$P(DATA(99.2),U,I)
  1.  W:'$D(ZTQUEUED) "."
  1.  F I=0:0 S I=$O(DATA(I)) Q:'I  D 
  1.  .; 99.1 data not to be totalled
  1.  .I I=99.1 F J=1:1:3 S $P(^TMP($J,START,NM,PR,CS,I),U,J)=$P(DATA(I),U,J)
  1.  .; Add data to get weekly totals.
  1.  .E  F J=1:1:$S($E(I)=5:24,I=99:6,I=99.2:3,I=99.3:9,99.5:3,1:9) D 
  1.  ..S $P(^TMP($J,START,NM,PR,CS,I),U,J)=$P($G(^TMP($J,START,NM,PR,CS,I)),U,J)+$P(DATA(I),U,J)
  1.  ;
  1.  Q
  1.  ;
  1. SYNC(IEN,NM,PR,DATA) ; compile asynchronous stats
  1.  ;-----------------------------------------------------------------------
  1.  ; IEN..... Ien for file #8973.1 (CM HL7 DATA)
  1.  ; NM...... Namespace (free text)
  1.  ; PR...... Protocol (free text)
  1.  ; DATA().. Array containing node data for file #8973.1 (CM HL7 DATA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(IEN)
  1.  Q:$G(NM)=""
  1.  Q:$G(PR)=""
  1.  Q:'$D(DATA)
  1.  N I,J
  1.  S ^TMP($J,START,NM,PR,0)=DATA(0)
  1.  ; node 99.1 is for national database (end date^facility name)
  1.  S DATA(99.1)=END_"^"_$P(SITE,U,2)_"^"_$P(SITE,U,3)
  1.  ; pieces 6 through 13 of node 99.2 contain text
  1.  F I=6:1:13 S $P(^TMP($J,START,NM,PR,99.2),U,I)=$P(DATA(99.2),U,I)
  1.  W:'$D(ZTQUEUED) "."
  1.  F I=0:0 S I=$O(DATA(I)) Q:'I  D 
  1.  .; 99.1 data not to be totalled
  1.  .I I=99.1 F J=1:1:3 S $P(^TMP($J,START,NM,PR,I),U,J)=$P(DATA(I),U,J)
  1.  .; Add data to get weekly totals.
  1.  .E  F J=1:1:$S(I=99:6,1:9) D 
  1.  ..S $P(^TMP($J,START,NM,PR,I),U,J)=$P($G(^TMP($J,START,NM,PR,I)),U,J)+$P(DATA(I),U,J)
  1.  Q
  1.  ;
  1. TRANSMIT ;-- format TMPARRY data, put into e-mail and send to cm.
  1.  ;
  1.  Q:'$D(^TMP($J))
  1.  ;
  1.  N C,CPU,HRSDAYS,I,IEN,LN,N,P,S,TL,TRANSTO,XMSUB,X,XMTEXT,XMY,XMZ,Y,Z
  1.  ;
  1.  K ^TMP("KMPDHU01-2",$J)
  1.  ;
  1.  S LN=0
  1.  ; version and patch info
  1.  S LN=LN+1,^TMP("KMPDHU01-2",$J,LN)="VERSION="_$$VERSION^KMPDUTL
  1.  ; system information
  1.  S LN=LN+1,^TMP("KMPDHU01-2",$J,LN)="SYSINFO="_$$SYSINFO^KMPDUTL1()
  1.  ; send cpu data to national database
  1.  D CPU^KMPDUTL5(.CPU) I $D(CPU) S I="" F  S I=$O(CPU(I)) Q:I=""  D 
  1.  .S LN=LN+1,^TMP("KMPDHU01-2",$J,LN)="CPU="_I_U_CPU(I)
  1.  ;
  1.  W:'$D(ZTQUEUED) !!,"Formatting ",$$FMTE^XLFDT($G(START))," data for mail delivery..."
  1.  ; reformat so that data is in ^TMP("KMPR UPLOAD",$J,LN)= format.
  1.  S IEN=0,S=""
  1.  F  S S=$O(^TMP($J,S)) Q:S=""  S N="" W "." D 
  1.  .F  S N=$O(^TMP($J,S,N)) Q:N=""  S P="" D 
  1.  ..F  S P=$O(^TMP($J,S,N,P)) Q:P=""  S I="",IEN=IEN+1 D 
  1.  ...; synchronous data
  1.  ...F  S I=$O(^TMP($J,S,N,P,I)) Q:(+I)'=I  S LN=LN+1 D 
  1.  ....S ^TMP("KMPDHU01-2",$J,LN)=IEN_","_I_")="_^TMP($J,S,N,P,I)
  1.  ...; asynchronous data
  1.  ...S C="-"
  1.  ...F  S C=$O(^TMP($J,S,N,P,C)) Q:C=""  S I="",IEN=IEN+1 D 
  1.  ....F  S I=$O(^TMP($J,S,N,P,C,I)) Q:(+I)'=I  S LN=LN+1 D
  1.  .....S ^TMP("KMPDHU01-2",$J,LN)=IEN_","_I_")="_^TMP($J,S,N,P,C,I)
  1.  ;
  1.  ; quit if no data to transmit.
  1.  Q:'$D(^TMP("KMPDHU01-2",$J))
  1.  S TL=$G(^KMPD(8973,"TEST LAB"))
  1.  S TL=$S(TL:"TESTLAB-",1:"")
  1.  ; send packman message.
  1.  S XMTEXT="^TMP(""KMPDHU01-2"","_$J_","
  1.  S XMSUB="CM HL7 DATA~"_TL_$P(SITE,U,2)_" ("_$P(SITE,U,3)_")~"_$$FMTE^XLFDT(START)
  1.  D TRANSTO^KMPDUTL7(1,3,.TRANSTO)
  1.  Q:'$D(TRANSTO)  S I=""
  1.  F  S I=$O(TRANSTO(I)) Q:I=""  S XMY(I)=""
  1.  D ^XMD
  1.  W:'$D(ZTQUEUED) !,"Message #",$G(XMZ)," sent..."
  1.  K ^TMP("KMPDHU01-2",$J)
  1.  ;
  1.  Q