- 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 Mar 13, 2025@20:45:13 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
