KMPDHU02 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04 08:58
;;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 HL7 data and stores it in file 8973.1 (CM HL7 DATA)
;
; Variables used:
; GBL...... Global where data is stored - for use with indirection
; GBL1..... globas where compiled data is stored before filing -
; used with indirection
;-----------------------------------------------------------------------
;
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
;
N ERROR,GBL,GBL1,STR,X
;
; get data from hl7 api
W:'$D(ZTQUEUED) !,"Gathering HL7 data..."
; global with 'raw' hl7 api data
S GBL=$NA(^TMP("KMPDH",$J)) K @GBL
; set up global to get asynchronous data
K ^TMP($J)
S ^TMP($J,"HLUCM")="DEBUG GLOBAL"
S X=$$CM2^HLUCM(KMPDST,KMPDEN,1,1,"KMPDH","EITHER",.ERROR)
I 'X!($D(ERROR))!('$D(^TMP("KMPDH",$J))) D Q
.W:'$D(ZTQUEUED) " no data to report"
;
; global for storing compiled data before filing
S GBL1=$NA(^TMP("KMPDH-1",$J)) K @GBL1
;
W:'$D(ZTQUEUED) !,"Compiling synchronous HL7 data..."
D SYNC
;
W:'$D(ZTQUEUED) !,"Compiling asynchronous HL7 data..."
D ASYNC
;
K @GBL,@GBL1,^TMP($J),^TMP("KMPDHERRTIME",$J)
W:'$D(ZTQUEUED) !,"Finished!"
;
Q
;
;
ASYNC ;- asynchronous data
Q:$G(GBL)=""
Q:$G(GBL1)=""
;
N COUNT,DATA,DATA1,DATA2,HOUR,I,IEN,IEN1,IEN2,J,LOCAL,MSG,NM,NODE
N OF,PIECE,PR,PTNP,SD,STDT,TIME1,TIME2,UNIT
;
; local site name
S LOCAL=$P($$SITE^VASITE,U,2) Q:LOCAL=""
S IEN=0
F S IEN=$O(^TMP($J,"HLUCMSTORE","U",IEN)) Q:'IEN S DATA=^(IEN) D
.; data = Protocol~Ien^Namespace
.; message type
.S MSG=$P(DATA,U,6)
.; quit if not 'complete' message
.Q:'$$ASYNCHK(MSG)
.; protocol - check protocol fist, then inferred protocol
.S PR=$S($P(DATA,U,7)]"":$P(DATA,U,7),$P(DATA,U,8)]"":$P(DATA,U,8),1:"") Q:PR=""
.; namespace - check namespace first, then inferred namespace
.S NM=$S($P(DATA,U,9)]"":$P(DATA,U,9),$P(DATA,U,10)]"":$P(DATA,U,10),1:"") Q:NM=""
.; other facility
.S OF=$P(DATA,U,11) S:OF["~" OF=$P(OF,"~",2) Q:OF=""
.; quit if other facility is LOCAL
.Q:OF[LOCAL
.; start date/time
.S STDT=$P(DATA,U,4) Q:'STDT
.; date without time
.S SD=$P(STDT,".") Q:'SD
.S $P(@GBL1@(SD,PR,NM,OF,99.2),U,11)=$P($P(DATA,U,11),"~")
.S $P(@GBL1@(SD,PR,NM,OF,99.2),U,12)=$P($P(DATA,U,11),"~",2)
.S $P(@GBL1@(SD,PR,NM,OF,99.2),U,13)=$P($P(DATA,U,11),"~",3)
.;
.S (COUNT,HOUR,IEN1)=0 K UNIT
.F S IEN1=$O(^TMP($J,"HLUCMSTORE","U",IEN,IEN1)) Q:'IEN1 D
..; data1 = piece 1 - Characters
..; piece 2 - Messages
..; piece 3 - Seconds
..; piece 4 - Begining Time
..; piece 5 - End Time
..; piece 6 - Type: msg, ca, aa or ca
..; piece 7 - Protocol~Ien
..; piece 8 - Namespace
..S DATA1=$G(^TMP($J,"HLUCMSTORE","U",IEN,IEN1,"CCC")) Q:DATA1=""
..S COUNT=COUNT+1,UNIT(COUNT)=DATA1
.;
.; back to IEN level
.; quit if unit() array is not complete
.Q:'$$UNITS(MSG)
.; hour of transaction
.S HOUR=+$E($P(STDT,".",2),1,2),HOUR=HOUR+1
.; prime time or non-prime time
.S PTNP=$$PTNP^KMPDHU03(STDT) Q:'PTNP
.; node: 5 - prime time
.; 6 - non-prime time
.S NODE=$S(PTNP=2:6,1:5)
.;
.; update msg unit count - prime time or non-prime time
.S $P(@GBL1@(SD,PR,NM,OF,99.5),U,PTNP)=$P($G(@GBL1@(SD,PR,NM,OF,99.5)),U,PTNP)+1
.;update msg unit count - both prime time & non-prime time
.S $P(@GBL1@(SD,PR,NM,OF,99.5),U,3)=$P($G(@GBL1@(SD,PR,NM,OF,99.5)),U,3)+1
.; totals
.F J=0:0 S J=$O(UNIT(J)) Q:'J F I=1:1:3 D
..; total
..S $P(@GBL1@(SD,PR,NM,OF,99.2),U,I)=$P($G(@GBL1@(SD,PR,NM,OF,99.2)),U,I)+$P(UNIT(J),U,I)
..S $P(@GBL1@(SD,PR,NM,OF,99.3),U,(I+6))=$P($G(@GBL1@(SD,PR,NM,OF,99.3)),U,(I+6))+$P(UNIT(J),U,I)
..; prime time or non-prime time
..; ^ piece to set
..S PIECE=I+$S(PTNP=2:3,1:0)
..S $P(@GBL1@(SD,PR,NM,OF,99.3),U,PIECE)=$P($G(@GBL1@(SD,PR,NM,OF,99.3)),U,PIECE)+$P(UNIT(J),U,I)
.;
.; msg to ca - originating message to commit ack
.; ^ piece: 1 - characters
.; 2 - count
.; 3 - seconds
.F I=1:1:3 S $P(@GBL1@(SD,PR,NM,OF,NODE+(I*.1)),U,HOUR)=$P($G(@GBL1@(SD,PR,NM,OF,NODE+(I*.1))),U,HOUR)+($P(UNIT(1),U,I)+$P(UNIT(2),U,I))
.;
.; processing time (ca to aa) - commit ack ending time to application
.; ack starting time
.S TIME1=+$P(UNIT(3),U,4),TIME2=+$P(UNIT(2),U,5)
.S $P(@GBL1@(SD,PR,NM,OF,(NODE+(.4))),U,HOUR)=$$TIMEADD^KMPDU($P($G(@GBL1@(SD,PR,NM,OF,(NODE+(.4)))),U,HOUR)+$$FMDIFF^XLFDT(TIME2,(+TIME1),3))
.; processing time (ca to aa) - count
.S $P(@GBL1@(SD,PR,NM,OF,(NODE+(.5))),U,HOUR)=$P($G(@GBL1@(SD,PR,NM,OF,(NODE+(.5)))),U,HOUR)+1
.;
.; aa to ca - application ack to commit ack
.; ^ piece: 1 - characters
.; 2 - count
.; 3 - seconds
.F I=1:1:3 S $P(@GBL1@(SD,PR,NM,OF,NODE+(I+6*.1)),U,HOUR)=$P($G(@GBL1@(SD,PR,NM,OF,NODE+(I+6*.1))),U,HOUR)+($P(UNIT(3),U,I)+$P(UNIT(4),U,I))
;
D:$D(@GBL1) FILE^KMPDHU03(2)
;
Q
;
ASYNCHK(KMPDMSG) ;-- extrinsic function - check for 'complete' message
;-----------------------------------------------------------------------
; KMPDMGS... message ack designations
;
; Return: 0 - not a complete message
; 1 - complete message
;-----------------------------------------------------------------------
Q:$G(KMPDMSG)="" 0
Q:MSG="MSG~CA~AA~CA" 1
Q:MSG="MSG~CA~AR~CA" 1
Q:MSG="MSG~AA" 1
Q 0
;
UNITS(MSG) ;-- extrinsic function
;-----------------------------------------------------------------------
; MSG.... type of message: 'msg~aa', 'msg~ca~aa~ca', etc.
;
; Return: 0 - unit() array not complete
; 1 - unit() array is complete
;
; unit() array must be segmented into the following format:
; unit(1) = msg
; unit(2) = ca
; unit(3) = aa
; unit(4) = ca
; this data is then used to calculate characters, messages and seconds
;-----------------------------------------------------------------------
Q:$G(MSG)="" 0
; all messages must have unit(2)
Q:'$D(UNIT(2)) 0
; "msg~ca~aa~ca" & "msg~ca~ar~ca" messages must have unit(3) & unit(4)
I MSG="MSG~CA~AA~CA"!(MSG="MSG~CA~AR~CA") Q:'$D(UNIT(3)) 0
I MSG="MSG~CA~AA~CA"!(MSG="MSG~CA~AR~CA") Q:'$D(UNIT(4)) 0
; 'msg~aaa' messages contain only 2 unit() entries
; create 4 unit() entries for processing
I MSG="MSG~AA" D
.S (UNIT(3),UNIT(4))=UNIT(2),UNIT(2)=UNIT(1)
.S $P(UNIT(1),U,1,3)="0^0^0"
.S $P(UNIT(4),U,1,3)="0^0^0"
; calculate seconds
; msg to ca
S $P(UNIT(2),U,3)=$$FMDIFF^XLFDT($P(UNIT(2),U,5),$P(UNIT(1),U,4),2)
S:$P(UNIT(2),U,3)<0 $P(UNIT(2),U,3)=0
; ca to aa
S $P(UNIT(3),U,3)=$$FMDIFF^XLFDT($P(UNIT(3),U,5),$P(UNIT(2),U,5),2)
S:$P(UNIT(3),U,3)<0 $P(UNIT(3),U,3)=0
; aa to ca
S $P(UNIT(4),U,3)=$$FMDIFF^XLFDT($P(UNIT(4),U,5),$P(UNIT(3),U,5),2)
S:$P(UNIT(4),U,3)<0 $P(UNIT(4),U,3)=0
;
Q 1
;
SYNC ;- synchronous data
;-----------------------------------------------------------------------
; SS1...... subscript 1 - identifies data
; HR - hourly
; NMSP - namespace
; PROT - protocol
; SS2...... subscript 2 - identifies data sorted within SS1
; IO - incoming/outgoing messages
; LR - local/remote messages
; PR - protocol
; TM - type of transmission
;
; SS3...... subcript 3 - which identifier for SS2 is being sorted
; IO - I - incoming
; O - outgoing
; U - unknown
; LR - L - local
; R - remote
; U - unknown
; PR - P - placeholder for consistent subscripting
; TM - M - mailman
; T - tcp
; U -unknown
; SS4...... subscript 4 - according to SS1
; HR - date.time
; NMSP - namespace
; PROT - protocal
; SS5...... subcript 5 - according to SS1
; HR - namespace
; NMSP - date.tim
; PROT - namespace
; SS6...... subscript 6 - according to SS1
; HR - protocol
; NMSP - protocol
; PROT - date.time
;-----------------------------------------------------------------------
Q:$G(GBL)=""
Q:$G(GBL1)=""
N SS1,SS2,SS3,SS4,SS5,SS6
S SS1=""
F S SS1=$O(@GBL@(SS1)) Q:SS1="" I SS1'="RFAC" S SS2="" D
.F S SS2=$O(@GBL@(SS1,SS2)) Q:SS2="" S SS3="" D
..F S SS3=$O(@GBL@(SS1,SS2,SS3)) Q:SS3="" S SS4="" D
...F S SS4=$O(@GBL@(SS1,SS2,SS3,SS4)) Q:SS4="" S SS5="" D
....Q:SS1="PROT"&(SS4="ZZZ")
....F S SS5=$O(@GBL@(SS1,SS2,SS3,SS4,SS5)) Q:SS5="" S SS6="" D
.....; if SS1="NMSP" or SS1="PROT" quit if SS4 and SS5 (protocol/
.....; namespace pair) = ZZZ
.....I SS1="NMSP"!(SS1="PROT") Q:SS4="ZZZ"&(SS5="ZZZ")
.....F S SS6=$O(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6)) Q:SS6="" D
......Q:SS1="HR"&(SS6="ZZZ")
......Q:SS1="NMSP"&(SS6="ZZZ")
......; compile data into daily stats for file #8973.1 (CM HL7 DATA)
......D COMPILE^KMPDHU03
;
D:$D(@GBL1) FILE^KMPDHU03(1)
;
K @GBL1
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDHU02 9502 printed Apr 09, 2024@20:46:49 Page 2
KMPDHU02 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04 08:58
+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 HL7 data and stores it in file 8973.1 (CM HL7 DATA)
+6 ;
+7 ; Variables used:
+8 ; GBL...... Global where data is stored - for use with indirection
+9 ; GBL1..... globas where compiled data is stored before filing -
+10 ; used with indirection
+11 ;-----------------------------------------------------------------------
+12 ;
+13 if '$GET(KMPDST)
QUIT
+14 if '$GET(KMPDEN)
QUIT
+15 ; make sure end date has hours
+16 if '$PIECE(KMPDEN,".",2)
SET $PIECE(KMPDEN,".",2)="99"
+17 if '$GET(DT)
SET DT=$$DT^XLFDT
+18 ;
+19 NEW ERROR,GBL,GBL1,STR,X
+20 ;
+21 ; get data from hl7 api
+22 if '$DATA(ZTQUEUED)
WRITE !,"Gathering HL7 data..."
+23 ; global with 'raw' hl7 api data
+24 SET GBL=$NAME(^TMP("KMPDH",$JOB))
KILL @GBL
+25 ; set up global to get asynchronous data
+26 KILL ^TMP($JOB)
+27 SET ^TMP($JOB,"HLUCM")="DEBUG GLOBAL"
+28 SET X=$$CM2^HLUCM(KMPDST,KMPDEN,1,1,"KMPDH","EITHER",.ERROR)
+29 IF 'X!($DATA(ERROR))!('$DATA(^TMP("KMPDH",$JOB)))
Begin DoDot:1
+30 if '$DATA(ZTQUEUED)
WRITE " no data to report"
End DoDot:1
QUIT
+31 ;
+32 ; global for storing compiled data before filing
+33 SET GBL1=$NAME(^TMP("KMPDH-1",$JOB))
KILL @GBL1
+34 ;
+35 if '$DATA(ZTQUEUED)
WRITE !,"Compiling synchronous HL7 data..."
+36 DO SYNC
+37 ;
+38 if '$DATA(ZTQUEUED)
WRITE !,"Compiling asynchronous HL7 data..."
+39 DO ASYNC
+40 ;
+41 KILL @GBL,@GBL1,^TMP($JOB),^TMP("KMPDHERRTIME",$JOB)
+42 if '$DATA(ZTQUEUED)
WRITE !,"Finished!"
+43 ;
+44 QUIT
+45 ;
+46 ;
ASYNC ;- asynchronous data
+1 if $GET(GBL)=""
QUIT
+2 if $GET(GBL1)=""
QUIT
+3 ;
+4 NEW COUNT,DATA,DATA1,DATA2,HOUR,I,IEN,IEN1,IEN2,J,LOCAL,MSG,NM,NODE
+5 NEW OF,PIECE,PR,PTNP,SD,STDT,TIME1,TIME2,UNIT
+6 ;
+7 ; local site name
+8 SET LOCAL=$PIECE($$SITE^VASITE,U,2)
if LOCAL=""
QUIT
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^TMP($JOB,"HLUCMSTORE","U",IEN))
if 'IEN
QUIT
SET DATA=^(IEN)
Begin DoDot:1
+11 ; data = Protocol~Ien^Namespace
+12 ; message type
+13 SET MSG=$PIECE(DATA,U,6)
+14 ; quit if not 'complete' message
+15 if '$$ASYNCHK(MSG)
QUIT
+16 ; protocol - check protocol fist, then inferred protocol
+17 SET PR=$SELECT($PIECE(DATA,U,7)]"":$PIECE(DATA,U,7),$PIECE(DATA,U,8)]"":$PIECE(DATA,U,8),1:"")
if PR=""
QUIT
+18 ; namespace - check namespace first, then inferred namespace
+19 SET NM=$SELECT($PIECE(DATA,U,9)]"":$PIECE(DATA,U,9),$PIECE(DATA,U,10)]"":$PIECE(DATA,U,10),1:"")
if NM=""
QUIT
+20 ; other facility
+21 SET OF=$PIECE(DATA,U,11)
if OF["~"
SET OF=$PIECE(OF,"~",2)
if OF=""
QUIT
+22 ; quit if other facility is LOCAL
+23 if OF[LOCAL
QUIT
+24 ; start date/time
+25 SET STDT=$PIECE(DATA,U,4)
if 'STDT
QUIT
+26 ; date without time
+27 SET SD=$PIECE(STDT,".")
if 'SD
QUIT
+28 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.2),U,11)=$PIECE($PIECE(DATA,U,11),"~")
+29 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.2),U,12)=$PIECE($PIECE(DATA,U,11),"~",2)
+30 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.2),U,13)=$PIECE($PIECE(DATA,U,11),"~",3)
+31 ;
+32 SET (COUNT,HOUR,IEN1)=0
KILL UNIT
+33 FOR
SET IEN1=$ORDER(^TMP($JOB,"HLUCMSTORE","U",IEN,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+34 ; data1 = piece 1 - Characters
+35 ; piece 2 - Messages
+36 ; piece 3 - Seconds
+37 ; piece 4 - Begining Time
+38 ; piece 5 - End Time
+39 ; piece 6 - Type: msg, ca, aa or ca
+40 ; piece 7 - Protocol~Ien
+41 ; piece 8 - Namespace
+42 SET DATA1=$GET(^TMP($JOB,"HLUCMSTORE","U",IEN,IEN1,"CCC"))
if DATA1=""
QUIT
+43 SET COUNT=COUNT+1
SET UNIT(COUNT)=DATA1
End DoDot:2
+44 ;
+45 ; back to IEN level
+46 ; quit if unit() array is not complete
+47 if '$$UNITS(MSG)
QUIT
+48 ; hour of transaction
+49 SET HOUR=+$EXTRACT($PIECE(STDT,".",2),1,2)
SET HOUR=HOUR+1
+50 ; prime time or non-prime time
+51 SET PTNP=$$PTNP^KMPDHU03(STDT)
if 'PTNP
QUIT
+52 ; node: 5 - prime time
+53 ; 6 - non-prime time
+54 SET NODE=$SELECT(PTNP=2:6,1:5)
+55 ;
+56 ; update msg unit count - prime time or non-prime time
+57 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.5),U,PTNP)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,99.5)),U,PTNP)+1
+58 ;update msg unit count - both prime time & non-prime time
+59 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.5),U,3)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,99.5)),U,3)+1
+60 ; totals
+61 FOR J=0:0
SET J=$ORDER(UNIT(J))
if 'J
QUIT
FOR I=1:1:3
Begin DoDot:2
+62 ; total
+63 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.2),U,I)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,99.2)),U,I)+$PIECE(UNIT(J),U,I)
+64 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.3),U,(I+6))=$PIECE($GET(@GBL1@(SD,PR,NM,OF,99.3)),U,(I+6))+$PIECE(UNIT(J),U,I)
+65 ; prime time or non-prime time
+66 ; ^ piece to set
+67 SET PIECE=I+$SELECT(PTNP=2:3,1:0)
+68 SET $PIECE(@GBL1@(SD,PR,NM,OF,99.3),U,PIECE)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,99.3)),U,PIECE)+$PIECE(UNIT(J),U,I)
End DoDot:2
+69 ;
+70 ; msg to ca - originating message to commit ack
+71 ; ^ piece: 1 - characters
+72 ; 2 - count
+73 ; 3 - seconds
+74 FOR I=1:1:3
SET $PIECE(@GBL1@(SD,PR,NM,OF,NODE+(I*.1)),U,HOUR)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,NODE+(I*.1))),U,HOUR)+($PIECE(UNIT(1),U,I)+$PIECE(UNIT(2),U,I))
+75 ;
+76 ; processing time (ca to aa) - commit ack ending time to application
+77 ; ack starting time
+78 SET TIME1=+$PIECE(UNIT(3),U,4)
SET TIME2=+$PIECE(UNIT(2),U,5)
+79 SET $PIECE(@GBL1@(SD,PR,NM,OF,(NODE+(.4))),U,HOUR)=$$TIMEADD^KMPDU($PIECE($GET(@GBL1@(SD,PR,NM,OF,(NODE+(.4)))),U,HOUR)+$$FMDIFF^XLFDT(TIME2,(+TIME1),3))
+80 ; processing time (ca to aa) - count
+81 SET $PIECE(@GBL1@(SD,PR,NM,OF,(NODE+(.5))),U,HOUR)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,(NODE+(.5)))),U,HOUR)+1
+82 ;
+83 ; aa to ca - application ack to commit ack
+84 ; ^ piece: 1 - characters
+85 ; 2 - count
+86 ; 3 - seconds
+87 FOR I=1:1:3
SET $PIECE(@GBL1@(SD,PR,NM,OF,NODE+(I+6*.1)),U,HOUR)=$PIECE($GET(@GBL1@(SD,PR,NM,OF,NODE+(I+6*.1))),U,HOUR)+($PIECE(UNIT(3),U,I)+$PIECE(UNIT(4),U,I))
End DoDot:1
+88 ;
+89 if $DATA(@GBL1)
DO FILE^KMPDHU03(2)
+90 ;
+91 QUIT
+92 ;
ASYNCHK(KMPDMSG) ;-- extrinsic function - check for 'complete' message
+1 ;-----------------------------------------------------------------------
+2 ; KMPDMGS... message ack designations
+3 ;
+4 ; Return: 0 - not a complete message
+5 ; 1 - complete message
+6 ;-----------------------------------------------------------------------
+7 if $GET(KMPDMSG)=""
QUIT 0
+8 if MSG="MSG~CA~AA~CA"
QUIT 1
+9 if MSG="MSG~CA~AR~CA"
QUIT 1
+10 if MSG="MSG~AA"
QUIT 1
+11 QUIT 0
+12 ;
UNITS(MSG) ;-- extrinsic function
+1 ;-----------------------------------------------------------------------
+2 ; MSG.... type of message: 'msg~aa', 'msg~ca~aa~ca', etc.
+3 ;
+4 ; Return: 0 - unit() array not complete
+5 ; 1 - unit() array is complete
+6 ;
+7 ; unit() array must be segmented into the following format:
+8 ; unit(1) = msg
+9 ; unit(2) = ca
+10 ; unit(3) = aa
+11 ; unit(4) = ca
+12 ; this data is then used to calculate characters, messages and seconds
+13 ;-----------------------------------------------------------------------
+14 if $GET(MSG)=""
QUIT 0
+15 ; all messages must have unit(2)
+16 if '$DATA(UNIT(2))
QUIT 0
+17 ; "msg~ca~aa~ca" & "msg~ca~ar~ca" messages must have unit(3) & unit(4)
+18 IF MSG="MSG~CA~AA~CA"!(MSG="MSG~CA~AR~CA")
if '$DATA(UNIT(3))
QUIT 0
+19 IF MSG="MSG~CA~AA~CA"!(MSG="MSG~CA~AR~CA")
if '$DATA(UNIT(4))
QUIT 0
+20 ; 'msg~aaa' messages contain only 2 unit() entries
+21 ; create 4 unit() entries for processing
+22 IF MSG="MSG~AA"
Begin DoDot:1
+23 SET (UNIT(3),UNIT(4))=UNIT(2)
SET UNIT(2)=UNIT(1)
+24 SET $PIECE(UNIT(1),U,1,3)="0^0^0"
+25 SET $PIECE(UNIT(4),U,1,3)="0^0^0"
End DoDot:1
+26 ; calculate seconds
+27 ; msg to ca
+28 SET $PIECE(UNIT(2),U,3)=$$FMDIFF^XLFDT($PIECE(UNIT(2),U,5),$PIECE(UNIT(1),U,4),2)
+29 if $PIECE(UNIT(2),U,3)<0
SET $PIECE(UNIT(2),U,3)=0
+30 ; ca to aa
+31 SET $PIECE(UNIT(3),U,3)=$$FMDIFF^XLFDT($PIECE(UNIT(3),U,5),$PIECE(UNIT(2),U,5),2)
+32 if $PIECE(UNIT(3),U,3)<0
SET $PIECE(UNIT(3),U,3)=0
+33 ; aa to ca
+34 SET $PIECE(UNIT(4),U,3)=$$FMDIFF^XLFDT($PIECE(UNIT(4),U,5),$PIECE(UNIT(3),U,5),2)
+35 if $PIECE(UNIT(4),U,3)<0
SET $PIECE(UNIT(4),U,3)=0
+36 ;
+37 QUIT 1
+38 ;
SYNC ;- synchronous data
+1 ;-----------------------------------------------------------------------
+2 ; SS1...... subscript 1 - identifies data
+3 ; HR - hourly
+4 ; NMSP - namespace
+5 ; PROT - protocol
+6 ; SS2...... subscript 2 - identifies data sorted within SS1
+7 ; IO - incoming/outgoing messages
+8 ; LR - local/remote messages
+9 ; PR - protocol
+10 ; TM - type of transmission
+11 ;
+12 ; SS3...... subcript 3 - which identifier for SS2 is being sorted
+13 ; IO - I - incoming
+14 ; O - outgoing
+15 ; U - unknown
+16 ; LR - L - local
+17 ; R - remote
+18 ; U - unknown
+19 ; PR - P - placeholder for consistent subscripting
+20 ; TM - M - mailman
+21 ; T - tcp
+22 ; U -unknown
+23 ; SS4...... subscript 4 - according to SS1
+24 ; HR - date.time
+25 ; NMSP - namespace
+26 ; PROT - protocal
+27 ; SS5...... subcript 5 - according to SS1
+28 ; HR - namespace
+29 ; NMSP - date.tim
+30 ; PROT - namespace
+31 ; SS6...... subscript 6 - according to SS1
+32 ; HR - protocol
+33 ; NMSP - protocol
+34 ; PROT - date.time
+35 ;-----------------------------------------------------------------------
+36 if $GET(GBL)=""
QUIT
+37 if $GET(GBL1)=""
QUIT
+38 NEW SS1,SS2,SS3,SS4,SS5,SS6
+39 SET SS1=""
+40 FOR
SET SS1=$ORDER(@GBL@(SS1))
if SS1=""
QUIT
IF SS1'="RFAC"
SET SS2=""
Begin DoDot:1
+41 FOR
SET SS2=$ORDER(@GBL@(SS1,SS2))
if SS2=""
QUIT
SET SS3=""
Begin DoDot:2
+42 FOR
SET SS3=$ORDER(@GBL@(SS1,SS2,SS3))
if SS3=""
QUIT
SET SS4=""
Begin DoDot:3
+43 FOR
SET SS4=$ORDER(@GBL@(SS1,SS2,SS3,SS4))
if SS4=""
QUIT
SET SS5=""
Begin DoDot:4
+44 if SS1="PROT"&(SS4="ZZZ")
QUIT
+45 FOR
SET SS5=$ORDER(@GBL@(SS1,SS2,SS3,SS4,SS5))
if SS5=""
QUIT
SET SS6=""
Begin DoDot:5
+46 ; if SS1="NMSP" or SS1="PROT" quit if SS4 and SS5 (protocol/
+47 ; namespace pair) = ZZZ
+48 IF SS1="NMSP"!(SS1="PROT")
if SS4="ZZZ"&(SS5="ZZZ")
QUIT
+49 FOR
SET SS6=$ORDER(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6))
if SS6=""
QUIT
Begin DoDot:6
+50 if SS1="HR"&(SS6="ZZZ")
QUIT
+51 if SS1="NMSP"&(SS6="ZZZ")
QUIT
+52 ; compile data into daily stats for file #8973.1 (CM HL7 DATA)
+53 DO COMPILE^KMPDHU03
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+54 ;
+55 if $DATA(@GBL1)
DO FILE^KMPDHU03(1)
+56 ;
+57 KILL @GBL1
+58 ;
+59 QUIT
