KMPDHU02 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04  08:58
 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
 ;
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