KMPDHU01 ;OAK/RAK - CM Tools HL7 Utility ;6/21/05 10:12
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
WEEKLY(KMPDT,KMPDPRGE) ;-- compress daily stats to weekly
;-----------------------------------------------------------------------
; KMPDT.... Compression date in internal fileman formt. This date
; must be a Sunday. It represents the date from which the
; previous weeks data should be compressed.
; Example: if KMPDT = 2981011 then compression will begin
; on 2981010 (KMPDT-1)
; KMPDPRGE. 0 - do not purge data from file #8973.1
; 1 - purge data from file #8973.1
;
; Every Sunday compress the daily stats in file #8973.1 into weekly
; and upload the data to the CM RUM National Database
;-----------------------------------------------------------------------
;
Q:'$G(KMPDT)
S KMPDPRGE=+$G(KMPDPRGE)
;
N DATA,DATE,DDLDT,DELDATE,EN,END,HOURS,I,IEN,J,NM,PT,SITE,STR,START,SYNC
;
; quit if not sunday.
Q:$$DOW^XLFDT(KMPDT,1)
; storage processed
K ^TMP($J),^TMP("KMPDHU01",$J)
; site info.
S SITE=$$SITE^VASITE Q:SITE=""
S DATE=KMPDT
S (START,END)="",STR=$$NOW^XLFDT
; days to keep - this is represented by 'weeks to keep' in file #8973
; so must be converted to days
S DDLDT=$P($G(^KMPD(8973,1,3)),U,11)*7
S:'DDLDT DDLDT=14
; Date to begin deletion.
S DELDATE=$$FMADD^XLFDT(KMPDT,-DDLDT)
;
W:'$D(ZTQUEUED) !,"Compressing data into weekly format..."
; Reverse $order to get previous dates.
F S DATE=$O(^KMPD(8973.1,"B",DATE),-1) Q:'DATE D
.; If DATE is saturday set START and END dates and kill TMPARRY.
.I $$DOW^XLFDT(DATE,1)=6 D
..S END=DATE,START=$$FMADD^XLFDT(DATE,-6)
..K ^TMP($J)
.Q:'START
.S SYNC=0
.F S SYNC=$O(^KMPD(8973.1,"ASYNC",DATE,SYNC)) Q:'SYNC S IEN=0 D
..F S IEN=$O(^KMPD(8973.1,"ASYNC",DATE,SYNC,IEN)) Q:'IEN D
...Q:'$D(^KMPD(8973.1,IEN,0))
...; data nodes into DATA() array.
...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))
...; quit if data has already been sent to national database
...Q:$P(DATA(0),U,2)
...; quit if no namespace or protocol
...S NM=$P(DATA(0),U,3),PT=$P(DATA(0),U,5) Q:NM=""!(PT="")
...; change first piece to start date (this is for national database)
...S $P(DATA(0),U)=START
...; second piece not applicable to national database
...S $P(DATA(0),U,2)=""
...D @$S(SYNC=2:"ASYNC(IEN,NM,PT,.DATA)",1:"SYNC(IEN,NM,PT,.DATA)")
...; add to processed array.
...S ^TMP("KMPDHU01",$J,IEN)=""
.;
.; Back to DATE level.
.; If START then transmit data.
.I DATE=START I $D(^TMP($J)) D TRANSMIT K ^TMP($J)
;
D:$D(^TMP($J)) TRANSMIT
K ^TMP($J)
;
; update field .02 (SENT TO CM NATIONAL DATABASE) to 'YES' for all
; processed entries.
W:'$D(ZTQUEUED) !!,"Updating records to reflect transmission..."
S IEN=0
F S IEN=$O(^TMP("KMPDHU01",$J,IEN)) Q:'IEN D
.K FDA,ERROR W:'$D(ZTQUEUED) "."
.S FDA($J,8973.1,IEN_",",.02)=1
.D FILE^DIE("","FDA($J)","ERROR")
;
K ^TMP("KMPDHU01",$J)
;
S STR=$$NOW^XLFDT
; leave two complete weeks of data in file #8973.1
D:KMPDPRGE PURGE^KMPDUTL3(DELDATE)
D STRSTP^KMPDUTL2(3,2,2,STR)
;
W:'$D(ZTQUEUED) !!,"Finished!"
;
Q
;
ASYNC(IEN,NM,PR,DATA) ; compile asynchronous stats
;-----------------------------------------------------------------------
; IEN..... Ien for file #8973.1 (CM HL7 DATA)
; NM...... Namespace (free text)
; PR...... Protocol (free text)
; DATA().. Array containing node data for file #8973.1 (CM HL7 DATA)
;-----------------------------------------------------------------------
Q:'$G(IEN)
Q:$G(NM)=""
Q:$G(PR)=""
Q:'$D(DATA)
N CS,I,J
; quit if no contact site
S CS=$P(DATA(99.2),U,12) Q:CS=""
S ^TMP($J,START,NM,PR,CS,0)=DATA(0)
; node 99.1 is for national database (end date^facility name)
S DATA(99.1)=END_"^"_$P(SITE,U,2)_"^"_$P(SITE,U,3)
; pieces 6 through 13 of node 99.2 contain text
F I=6:1:13 S $P(^TMP($J,START,NM,PR,CS,99.2),U,I)=$P(DATA(99.2),U,I)
W:'$D(ZTQUEUED) "."
F I=0:0 S I=$O(DATA(I)) Q:'I D
.; 99.1 data not to be totalled
.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)
.; Add data to get weekly totals.
.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
..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)
;
Q
;
SYNC(IEN,NM,PR,DATA) ; compile asynchronous stats
;-----------------------------------------------------------------------
; IEN..... Ien for file #8973.1 (CM HL7 DATA)
; NM...... Namespace (free text)
; PR...... Protocol (free text)
; DATA().. Array containing node data for file #8973.1 (CM HL7 DATA)
;-----------------------------------------------------------------------
Q:'$G(IEN)
Q:$G(NM)=""
Q:$G(PR)=""
Q:'$D(DATA)
N I,J
S ^TMP($J,START,NM,PR,0)=DATA(0)
; node 99.1 is for national database (end date^facility name)
S DATA(99.1)=END_"^"_$P(SITE,U,2)_"^"_$P(SITE,U,3)
; pieces 6 through 13 of node 99.2 contain text
F I=6:1:13 S $P(^TMP($J,START,NM,PR,99.2),U,I)=$P(DATA(99.2),U,I)
W:'$D(ZTQUEUED) "."
F I=0:0 S I=$O(DATA(I)) Q:'I D
.; 99.1 data not to be totalled
.I I=99.1 F J=1:1:3 S $P(^TMP($J,START,NM,PR,I),U,J)=$P(DATA(I),U,J)
.; Add data to get weekly totals.
.E F J=1:1:$S(I=99:6,1:9) D
..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)
Q
;
TRANSMIT ;-- format TMPARRY data, put into e-mail and send to cm.
;
Q:'$D(^TMP($J))
;
N C,CPU,HRSDAYS,I,IEN,LN,N,P,S,TL,TRANSTO,XMSUB,X,XMTEXT,XMY,XMZ,Y,Z
;
K ^TMP("KMPDHU01-2",$J)
;
S LN=0
; version and patch info
S LN=LN+1,^TMP("KMPDHU01-2",$J,LN)="VERSION="_$$VERSION^KMPDUTL
; system information
S LN=LN+1,^TMP("KMPDHU01-2",$J,LN)="SYSINFO="_$$SYSINFO^KMPDUTL1()
; send cpu data to national database
D CPU^KMPDUTL5(.CPU) I $D(CPU) S I="" F S I=$O(CPU(I)) Q:I="" D
.S LN=LN+1,^TMP("KMPDHU01-2",$J,LN)="CPU="_I_U_CPU(I)
;
W:'$D(ZTQUEUED) !!,"Formatting ",$$FMTE^XLFDT($G(START))," data for mail delivery..."
; reformat so that data is in ^TMP("KMPR UPLOAD",$J,LN)= format.
S IEN=0,S=""
F S S=$O(^TMP($J,S)) Q:S="" S N="" W "." D
.F S N=$O(^TMP($J,S,N)) Q:N="" S P="" D
..F S P=$O(^TMP($J,S,N,P)) Q:P="" S I="",IEN=IEN+1 D
...; synchronous data
...F S I=$O(^TMP($J,S,N,P,I)) Q:(+I)'=I S LN=LN+1 D
....S ^TMP("KMPDHU01-2",$J,LN)=IEN_","_I_")="_^TMP($J,S,N,P,I)
...; asynchronous data
...S C="-"
...F S C=$O(^TMP($J,S,N,P,C)) Q:C="" S I="",IEN=IEN+1 D
....F S I=$O(^TMP($J,S,N,P,C,I)) Q:(+I)'=I S LN=LN+1 D
.....S ^TMP("KMPDHU01-2",$J,LN)=IEN_","_I_")="_^TMP($J,S,N,P,C,I)
;
; quit if no data to transmit.
Q:'$D(^TMP("KMPDHU01-2",$J))
S TL=$G(^KMPD(8973,"TEST LAB"))
S TL=$S(TL:"TESTLAB-",1:"")
; send packman message.
S XMTEXT="^TMP(""KMPDHU01-2"","_$J_","
S XMSUB="CM HL7 DATA~"_TL_$P(SITE,U,2)_" ("_$P(SITE,U,3)_")~"_$$FMTE^XLFDT(START)
D TRANSTO^KMPDUTL7(1,3,.TRANSTO)
Q:'$D(TRANSTO) S I=""
F S I=$O(TRANSTO(I)) Q:I="" S XMY(I)=""
D ^XMD
W:'$D(ZTQUEUED) !,"Message #",$G(XMZ)," sent..."
K ^TMP("KMPDHU01-2",$J)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDHU01 7244 printed Dec 13, 2024@01:40:33 Page 2
KMPDHU01 ;OAK/RAK - CM Tools HL7 Utility ;6/21/05 10:12
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
WEEKLY(KMPDT,KMPDPRGE) ;-- compress daily stats to weekly
+1 ;-----------------------------------------------------------------------
+2 ; KMPDT.... Compression date in internal fileman formt. This date
+3 ; must be a Sunday. It represents the date from which the
+4 ; previous weeks data should be compressed.
+5 ; Example: if KMPDT = 2981011 then compression will begin
+6 ; on 2981010 (KMPDT-1)
+7 ; KMPDPRGE. 0 - do not purge data from file #8973.1
+8 ; 1 - purge data from file #8973.1
+9 ;
+10 ; Every Sunday compress the daily stats in file #8973.1 into weekly
+11 ; and upload the data to the CM RUM National Database
+12 ;-----------------------------------------------------------------------
+13 ;
+14 if '$GET(KMPDT)
QUIT
+15 SET KMPDPRGE=+$GET(KMPDPRGE)
+16 ;
+17 NEW DATA,DATE,DDLDT,DELDATE,EN,END,HOURS,I,IEN,J,NM,PT,SITE,STR,START,SYNC
+18 ;
+19 ; quit if not sunday.
+20 if $$DOW^XLFDT(KMPDT,1)
QUIT
+21 ; storage processed
+22 KILL ^TMP($JOB),^TMP("KMPDHU01",$JOB)
+23 ; site info.
+24 SET SITE=$$SITE^VASITE
if SITE=""
QUIT
+25 SET DATE=KMPDT
+26 SET (START,END)=""
SET STR=$$NOW^XLFDT
+27 ; days to keep - this is represented by 'weeks to keep' in file #8973
+28 ; so must be converted to days
+29 SET DDLDT=$PIECE($GET(^KMPD(8973,1,3)),U,11)*7
+30 if 'DDLDT
SET DDLDT=14
+31 ; Date to begin deletion.
+32 SET DELDATE=$$FMADD^XLFDT(KMPDT,-DDLDT)
+33 ;
+34 if '$DATA(ZTQUEUED)
WRITE !,"Compressing data into weekly format..."
+35 ; Reverse $order to get previous dates.
+36 FOR
SET DATE=$ORDER(^KMPD(8973.1,"B",DATE),-1)
if 'DATE
QUIT
Begin DoDot:1
+37 ; If DATE is saturday set START and END dates and kill TMPARRY.
+38 IF $$DOW^XLFDT(DATE,1)=6
Begin DoDot:2
+39 SET END=DATE
SET START=$$FMADD^XLFDT(DATE,-6)
+40 KILL ^TMP($JOB)
End DoDot:2
+41 if 'START
QUIT
+42 SET SYNC=0
+43 FOR
SET SYNC=$ORDER(^KMPD(8973.1,"ASYNC",DATE,SYNC))
if 'SYNC
QUIT
SET IEN=0
Begin DoDot:2
+44 FOR
SET IEN=$ORDER(^KMPD(8973.1,"ASYNC",DATE,SYNC,IEN))
if 'IEN
QUIT
Begin DoDot:3
+45 if '$DATA(^KMPD(8973.1,IEN,0))
QUIT
+46 ; data nodes into DATA() array.
+47 SET DATA(0)=^KMPD(8973.1,IEN,0)
FOR 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
SET DATA(I)=$GET(^(I))
+48 ; quit if data has already been sent to national database
+49 if $PIECE(DATA(0),U,2)
QUIT
+50 ; quit if no namespace or protocol
+51 SET NM=$PIECE(DATA(0),U,3)
SET PT=$PIECE(DATA(0),U,5)
if NM=""!(PT="")
QUIT
+52 ; change first piece to start date (this is for national database)
+53 SET $PIECE(DATA(0),U)=START
+54 ; second piece not applicable to national database
+55 SET $PIECE(DATA(0),U,2)=""
+56 DO @$SELECT(SYNC=2:"ASYNC(IEN,NM,PT,.DATA)",1:"SYNC(IEN,NM,PT,.DATA)")
+57 ; add to processed array.
+58 SET ^TMP("KMPDHU01",$JOB,IEN)=""
End DoDot:3
End DoDot:2
+59 ;
+60 ; Back to DATE level.
+61 ; If START then transmit data.
+62 IF DATE=START
IF $DATA(^TMP($JOB))
DO TRANSMIT
KILL ^TMP($JOB)
End DoDot:1
+63 ;
+64 if $DATA(^TMP($JOB))
DO TRANSMIT
+65 KILL ^TMP($JOB)
+66 ;
+67 ; update field .02 (SENT TO CM NATIONAL DATABASE) to 'YES' for all
+68 ; processed entries.
+69 if '$DATA(ZTQUEUED)
WRITE !!,"Updating records to reflect transmission..."
+70 SET IEN=0
+71 FOR
SET IEN=$ORDER(^TMP("KMPDHU01",$JOB,IEN))
if 'IEN
QUIT
Begin DoDot:1
+72 KILL FDA,ERROR
if '$DATA(ZTQUEUED)
WRITE "."
+73 SET FDA($JOB,8973.1,IEN_",",.02)=1
+74 DO FILE^DIE("","FDA($J)","ERROR")
End DoDot:1
+75 ;
+76 KILL ^TMP("KMPDHU01",$JOB)
+77 ;
+78 SET STR=$$NOW^XLFDT
+79 ; leave two complete weeks of data in file #8973.1
+80 if KMPDPRGE
DO PURGE^KMPDUTL3(DELDATE)
+81 DO STRSTP^KMPDUTL2(3,2,2,STR)
+82 ;
+83 if '$DATA(ZTQUEUED)
WRITE !!,"Finished!"
+84 ;
+85 QUIT
+86 ;
ASYNC(IEN,NM,PR,DATA) ; compile asynchronous stats
+1 ;-----------------------------------------------------------------------
+2 ; IEN..... Ien for file #8973.1 (CM HL7 DATA)
+3 ; NM...... Namespace (free text)
+4 ; PR...... Protocol (free text)
+5 ; DATA().. Array containing node data for file #8973.1 (CM HL7 DATA)
+6 ;-----------------------------------------------------------------------
+7 if '$GET(IEN)
QUIT
+8 if $GET(NM)=""
QUIT
+9 if $GET(PR)=""
QUIT
+10 if '$DATA(DATA)
QUIT
+11 NEW CS,I,J
+12 ; quit if no contact site
+13 SET CS=$PIECE(DATA(99.2),U,12)
if CS=""
QUIT
+14 SET ^TMP($JOB,START,NM,PR,CS,0)=DATA(0)
+15 ; node 99.1 is for national database (end date^facility name)
+16 SET DATA(99.1)=END_"^"_$PIECE(SITE,U,2)_"^"_$PIECE(SITE,U,3)
+17 ; pieces 6 through 13 of node 99.2 contain text
+18 FOR I=6:1:13
SET $PIECE(^TMP($JOB,START,NM,PR,CS,99.2),U,I)=$PIECE(DATA(99.2),U,I)
+19 if '$DATA(ZTQUEUED)
WRITE "."
+20 FOR I=0:0
SET I=$ORDER(DATA(I))
if 'I
QUIT
Begin DoDot:1
+21 ; 99.1 data not to be totalled
+22 IF I=99.1
FOR J=1:1:3
SET $PIECE(^TMP($JOB,START,NM,PR,CS,I),U,J)=$PIECE(DATA(I),U,J)
+23 ; Add data to get weekly totals.
+24 IF '$TEST
FOR J=1:1:$SELECT($EXTRACT(I)=5:24,I=99:6,I=99.2:3,I=99.3:9,99.5:3,1:9)
Begin DoDot:2
+25 SET $PIECE(^TMP($JOB,START,NM,PR,CS,I),U,J)=$PIECE($GET(^TMP($JOB,START,NM,PR,CS,I)),U,J)+$PIECE(DATA(I),U,J)
End DoDot:2
End DoDot:1
+26 ;
+27 QUIT
+28 ;
SYNC(IEN,NM,PR,DATA) ; compile asynchronous stats
+1 ;-----------------------------------------------------------------------
+2 ; IEN..... Ien for file #8973.1 (CM HL7 DATA)
+3 ; NM...... Namespace (free text)
+4 ; PR...... Protocol (free text)
+5 ; DATA().. Array containing node data for file #8973.1 (CM HL7 DATA)
+6 ;-----------------------------------------------------------------------
+7 if '$GET(IEN)
QUIT
+8 if $GET(NM)=""
QUIT
+9 if $GET(PR)=""
QUIT
+10 if '$DATA(DATA)
QUIT
+11 NEW I,J
+12 SET ^TMP($JOB,START,NM,PR,0)=DATA(0)
+13 ; node 99.1 is for national database (end date^facility name)
+14 SET DATA(99.1)=END_"^"_$PIECE(SITE,U,2)_"^"_$PIECE(SITE,U,3)
+15 ; pieces 6 through 13 of node 99.2 contain text
+16 FOR I=6:1:13
SET $PIECE(^TMP($JOB,START,NM,PR,99.2),U,I)=$PIECE(DATA(99.2),U,I)
+17 if '$DATA(ZTQUEUED)
WRITE "."
+18 FOR I=0:0
SET I=$ORDER(DATA(I))
if 'I
QUIT
Begin DoDot:1
+19 ; 99.1 data not to be totalled
+20 IF I=99.1
FOR J=1:1:3
SET $PIECE(^TMP($JOB,START,NM,PR,I),U,J)=$PIECE(DATA(I),U,J)
+21 ; Add data to get weekly totals.
+22 IF '$TEST
FOR J=1:1:$SELECT(I=99:6,1:9)
Begin DoDot:2
+23 SET $PIECE(^TMP($JOB,START,NM,PR,I),U,J)=$PIECE($GET(^TMP($JOB,START,NM,PR,I)),U,J)+$PIECE(DATA(I),U,J)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
TRANSMIT ;-- format TMPARRY data, put into e-mail and send to cm.
+1 ;
+2 if '$DATA(^TMP($JOB))
QUIT
+3 ;
+4 NEW C,CPU,HRSDAYS,I,IEN,LN,N,P,S,TL,TRANSTO,XMSUB,X,XMTEXT,XMY,XMZ,Y,Z
+5 ;
+6 KILL ^TMP("KMPDHU01-2",$JOB)
+7 ;
+8 SET LN=0
+9 ; version and patch info
+10 SET LN=LN+1
SET ^TMP("KMPDHU01-2",$JOB,LN)="VERSION="_$$VERSION^KMPDUTL
+11 ; system information
+12 SET LN=LN+1
SET ^TMP("KMPDHU01-2",$JOB,LN)="SYSINFO="_$$SYSINFO^KMPDUTL1()
+13 ; send cpu data to national database
+14 DO CPU^KMPDUTL5(.CPU)
IF $DATA(CPU)
SET I=""
FOR
SET I=$ORDER(CPU(I))
if I=""
QUIT
Begin DoDot:1
+15 SET LN=LN+1
SET ^TMP("KMPDHU01-2",$JOB,LN)="CPU="_I_U_CPU(I)
End DoDot:1
+16 ;
+17 if '$DATA(ZTQUEUED)
WRITE !!,"Formatting ",$$FMTE^XLFDT($GET(START))," data for mail delivery..."
+18 ; reformat so that data is in ^TMP("KMPR UPLOAD",$J,LN)= format.
+19 SET IEN=0
SET S=""
+20 FOR
SET S=$ORDER(^TMP($JOB,S))
if S=""
QUIT
SET N=""
WRITE "."
Begin DoDot:1
+21 FOR
SET N=$ORDER(^TMP($JOB,S,N))
if N=""
QUIT
SET P=""
Begin DoDot:2
+22 FOR
SET P=$ORDER(^TMP($JOB,S,N,P))
if P=""
QUIT
SET I=""
SET IEN=IEN+1
Begin DoDot:3
+23 ; synchronous data
+24 FOR
SET I=$ORDER(^TMP($JOB,S,N,P,I))
if (+I)'=I
QUIT
SET LN=LN+1
Begin DoDot:4
+25 SET ^TMP("KMPDHU01-2",$JOB,LN)=IEN_","_I_")="_^TMP($JOB,S,N,P,I)
End DoDot:4
+26 ; asynchronous data
+27 SET C="-"
+28 FOR
SET C=$ORDER(^TMP($JOB,S,N,P,C))
if C=""
QUIT
SET I=""
SET IEN=IEN+1
Begin DoDot:4
+29 FOR
SET I=$ORDER(^TMP($JOB,S,N,P,C,I))
if (+I)'=I
QUIT
SET LN=LN+1
Begin DoDot:5
+30 SET ^TMP("KMPDHU01-2",$JOB,LN)=IEN_","_I_")="_^TMP($JOB,S,N,P,C,I)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ; quit if no data to transmit.
+33 if '$DATA(^TMP("KMPDHU01-2",$JOB))
QUIT
+34 SET TL=$GET(^KMPD(8973,"TEST LAB"))
+35 SET TL=$SELECT(TL:"TESTLAB-",1:"")
+36 ; send packman message.
+37 SET XMTEXT="^TMP(""KMPDHU01-2"","_$JOB_","
+38 SET XMSUB="CM HL7 DATA~"_TL_$PIECE(SITE,U,2)_" ("_$PIECE(SITE,U,3)_")~"_$$FMTE^XLFDT(START)
+39 DO TRANSTO^KMPDUTL7(1,3,.TRANSTO)
+40 if '$DATA(TRANSTO)
QUIT
SET I=""
+41 FOR
SET I=$ORDER(TRANSTO(I))
if I=""
QUIT
SET XMY(I)=""
+42 DO ^XMD
+43 if '$DATA(ZTQUEUED)
WRITE !,"Message #",$GET(XMZ)," sent..."
+44 KILL ^TMP("KMPDHU01-2",$JOB)
+45 ;
+46 QUIT
