KMPDHU03 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04 08:59
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
COMPILE ;-compile synchronous data into GLB1
;-----------------------------------------------------------------------
; DATA.... data from GBL array
; DATE.... date.hr
; ND...... node where data will be filed in file #8973.1
; LC...... up-arrow (^) piece location of data to be filed
; NM....... namespace
; PT...... protocol name~ien
; PTNP.... prime time - 1
; non-prime time 2
;-----------------------------------------------------------------------
;
N DATA,DATE,I,ND,LC,NM,PT,PTNP
;
Q:'$D(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6)) S DATA=$G(^(SS6)) Q:DATA=""
; namespace
S NM=$S(SS1="HR"!(SS1="PROT"):SS5,SS1="NMSP":SS4,1:"") Q:NM=""
; protocol
S PT=$S(SS1="HR"!(SS1="NMSP"):SS6,SS1="PROT":SS4,1:"") Q:PT=""
; prime time - 1, non-prime time - 2
S DATE=$S(SS1="HR":SS4,SS1="NMSP":SS5,SS1="PROT":SS6,1:"") Q:'DATE
; DATE is set by using the 'next highest' hour
; 3030509.0811 is returned as 3030509.09
; use $$fmadd to go back to previous hour
S PTNP=$$PTNP^KMPDHU03($$FMADD^XLFDT(DATE,,-1)) Q:'PTNP
;
I SS1="HR" D
.S ND=$S(SS2="TM":1,1:""),ND=ND+(PTNP-1)
.S LC=$S(SS3="T":0,SS3="M":3,SS3="U":6,1:"")
I SS1="NMSP" D
.S ND=$S(SS2="IO":1.1,SS2="LR":1.2,1:""),ND=ND+(PTNP-1)
.S LC=$S(SS3="I"!(SS3="L"):0,SS3="O"!(SS3="R"):3,SS3="U":6,1:"") Q:LC=""
I SS1="PROT" D
.S ND=99,LC=$S(PTNP=1:0,PTNP=2:3,1:"")
;
; quit if not node (ND) or location (LC)
Q:'$P(DATE,".")!('ND)!(LC="")
;
F I=1,3 D
.S $P(@GBL1@($P(DATE,"."),PT,NM,ND),U,(I+LC))=$P($G(@GBL1@($P(DATE,"."),PT,NM,ND)),U,(I+LC))+$P(DATA,U,I)
S $P(@GBL1@($P(DATE,"."),PT,NM,ND),U,(2+LC))=$P($G(@GBL1@($P(DATE,"."),PT,NM,ND)),U,(2+LC))+$P(DATA,U,4)
;
Q
;
FILE(KMPDSYNC) ;-file data into file 8973.1 (CM HL7 DATA)
;-----------------------------------------------------------------------
; KMPDSYNC... 1 - synchronous
; 2 - asynchronous
;-----------------------------------------------------------------------
Q:'$G(KMPDSYNC)
Q:KMPDSYNC<1!(KMPDSYNC>2)
Q:'$D(@GBL1)
;
W:'$D(ZTQUEUED) !,"Filing ",$S(KMPDSYNC=2:"asynchronous",1:"synchronous")," HL7 stats into file 8973.1 (CM HL7 DATA)..."
;
; file data
D @("FILE"_KMPDSYNC) Q:'$D(FDA)
;
Q
;
FILE1 ;-- file synchronous data
;
Q:'$D(@GBL1)
;
N DATE,ERROR,FDA,I,IEN,INDEX,NM,PT,PT1,ZIEN
;
S DATE=0
F S DATE=$O(@GBL1@(DATE)) Q:'DATE S PT="" D
.F S PT=$O(@GBL1@(DATE,PT)) Q:PT="" S NM="" D
..; remove ien (name~123) from protocol
..S PT1=$P(PT,"~") Q:PT1=""
..F S NM=$O(@GBL1@(DATE,PT,NM)) Q:NM="" S ND=0 D
...K ERROR,FDA,IEN,ZIEN
...; determine if data has already been filed (if ien)
...S IEN=$O(^KMPD(8973.1,"APTDTNM",PT1,DATE,NM,0))
...; if filed set IEN="ien," - edit entry
...; if not filed set IEN="+1," - add entry
...S IEN=$S(IEN:IEN_",",1:"+1,")
...S FDA($J,8973.1,IEN,.01)=DATE
...S FDA($J,8973.1,IEN,.03)=NM
...S FDA($J,8973.1,IEN,.05)=PT1
...S FDA($J,8973.1,IEN,.06)=1
...F S ND=$O(@GBL1@(DATE,PT,NM,ND)) Q:'ND D
....S DATA=@GBL1@(DATE,PT,NM,ND) Q:DATA=""
....S INDEX=$S(ND=99:6,ND=99.2:13,ND=99.5:3,$E(ND)=5:24,1:9)
....F I=1:1:INDEX S:$P(DATA,U,I)'="" FDA($J,8973.1,IEN,ND+(I*.001))=$P(DATA,U,I)
...; file data
...D UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
...; if error
...I $D(ERROR) D
....D MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
....D EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
;
Q
;
FILE2 ;-- file asynchronous data
;
Q:'$D(@GBL1)
;
N CF,DATE,ERROR,I,IEN,INDEX1,INDEX2,KMPDERR,NM,PT,PT1,ZIEN
;
K ^TMP($J,"KMPDHU03-F2")
S DATE=0
F S DATE=$O(@GBL1@(DATE)) Q:'DATE S PT="" D
.F S PT=$O(@GBL1@(DATE,PT)) Q:PT="" S NM="" D
..; remove ien (name~123) from protocol
..S PT1=$P(PT,"~") Q:PT1=""
..F S NM=$O(@GBL1@(DATE,PT,NM)) Q:NM="" S CF="" D
...F S CF=$O(@GBL1@(DATE,PT,NM,CF)) Q:CF="" S ND=0 D
....K ERROR,IEN,ZIEN,^TMP($J,"KMPDHU03-F2"),^TMP($J,"KMPDHU03-ERROR")
....; determine if data has already been filed (if ien)
....S IEN=$O(^KMPD(8973.1,"ACSDTPRNM",CF,DATE,PT1,NM,0))
....; if filed set IEN="ien," - edit entry
....; if not filed set IEN="+1," - add entry
....S IEN=$S(IEN:IEN_",",1:"+1,")
....; date
....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.01)=DATE
....; namespace
....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.03)=NM
....; protocol
....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.05)=PT1
....; 2 = asynchronous
....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.06)=2
....F S ND=$O(@GBL1@(DATE,PT,NM,CF,ND)) Q:'ND D
.....S DATA=@GBL1@(DATE,PT,NM,CF,ND) Q:DATA=""
.....; starting index
.....S INDEX1=1 ;$S($E(ND)=5:9,1:1)
.....; ending index
.....S INDEX2=$S(ND=99:6,ND=99.2:13,ND=99.3:9,ND=99.5:3,$E(ND)=5:24,$E(ND)=6:24,1:0)
.....Q:'INDEX2
.....F I=INDEX1:1:INDEX2 S:$P(DATA,U,I)'="" ^TMP($J,"KMPDHU03-F2",8973.1,IEN,ND+(I*.001))=$P(DATA,U,I)
....;file data
....D UPDATE^DIE("",$NA(^TMP($J,"KMPDHU03-F2")),"ZIEN","ERROR")
....; if error
....I $D(ERROR) D
.....D MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
.....D EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
;
K ^TMP($J,"KMPDHU03-F2")
;
Q
;
PTNP(DATE) ;-extrinsic function - determine if date.hr is prime time or non-prime time
;-----------------------------------------------------------------------
; DATE.... Date.Time in internal FileMan format
;
; Return: 1 - prime time
; 2 - non-prime time
; "" - unable to identify
;-----------------------------------------------------------------------
Q:'$G(DATE) ""
N DOW,HOUR
; day of week in numeric format
S DOW=$$DOW^XLFDT(DATE,1)
; hours
S HOUR=$E($P(DATE,".",2),1,2)
; prime time - not saturday or sunday or holiday and between the hours
; of 8am (0800) to 5 pm (1700)
Q:DOW'=0&(DOW'=6)&('$G(^HOLIDAY($P(DATE,"."),0)))&(HOUR>7)&(HOUR<17) 1
; non-prime time
Q 2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDHU03 5988 printed Oct 16, 2024@17:41:26 Page 2
KMPDHU03 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04 08:59
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
COMPILE ;-compile synchronous data into GLB1
+1 ;-----------------------------------------------------------------------
+2 ; DATA.... data from GBL array
+3 ; DATE.... date.hr
+4 ; ND...... node where data will be filed in file #8973.1
+5 ; LC...... up-arrow (^) piece location of data to be filed
+6 ; NM....... namespace
+7 ; PT...... protocol name~ien
+8 ; PTNP.... prime time - 1
+9 ; non-prime time 2
+10 ;-----------------------------------------------------------------------
+11 ;
+12 NEW DATA,DATE,I,ND,LC,NM,PT,PTNP
+13 ;
+14 if '$DATA(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6))
QUIT
SET DATA=$GET(^(SS6))
if DATA=""
QUIT
+15 ; namespace
+16 SET NM=$SELECT(SS1="HR"!(SS1="PROT"):SS5,SS1="NMSP":SS4,1:"")
if NM=""
QUIT
+17 ; protocol
+18 SET PT=$SELECT(SS1="HR"!(SS1="NMSP"):SS6,SS1="PROT":SS4,1:"")
if PT=""
QUIT
+19 ; prime time - 1, non-prime time - 2
+20 SET DATE=$SELECT(SS1="HR":SS4,SS1="NMSP":SS5,SS1="PROT":SS6,1:"")
if 'DATE
QUIT
+21 ; DATE is set by using the 'next highest' hour
+22 ; 3030509.0811 is returned as 3030509.09
+23 ; use $$fmadd to go back to previous hour
+24 SET PTNP=$$PTNP^KMPDHU03($$FMADD^XLFDT(DATE,,-1))
if 'PTNP
QUIT
+25 ;
+26 IF SS1="HR"
Begin DoDot:1
+27 SET ND=$SELECT(SS2="TM":1,1:"")
SET ND=ND+(PTNP-1)
+28 SET LC=$SELECT(SS3="T":0,SS3="M":3,SS3="U":6,1:"")
End DoDot:1
+29 IF SS1="NMSP"
Begin DoDot:1
+30 SET ND=$SELECT(SS2="IO":1.1,SS2="LR":1.2,1:"")
SET ND=ND+(PTNP-1)
+31 SET LC=$SELECT(SS3="I"!(SS3="L"):0,SS3="O"!(SS3="R"):3,SS3="U":6,1:"")
if LC=""
QUIT
End DoDot:1
+32 IF SS1="PROT"
Begin DoDot:1
+33 SET ND=99
SET LC=$SELECT(PTNP=1:0,PTNP=2:3,1:"")
End DoDot:1
+34 ;
+35 ; quit if not node (ND) or location (LC)
+36 if '$PIECE(DATE,".")!('ND)!(LC="")
QUIT
+37 ;
+38 FOR I=1,3
Begin DoDot:1
+39 SET $PIECE(@GBL1@($PIECE(DATE,"."),PT,NM,ND),U,(I+LC))=$PIECE($GET(@GBL1@($PIECE(DATE,"."),PT,NM,ND)),U,(I+LC))+$PIECE(DATA,U,I)
End DoDot:1
+40 SET $PIECE(@GBL1@($PIECE(DATE,"."),PT,NM,ND),U,(2+LC))=$PIECE($GET(@GBL1@($PIECE(DATE,"."),PT,NM,ND)),U,(2+LC))+$PIECE(DATA,U,4)
+41 ;
+42 QUIT
+43 ;
FILE(KMPDSYNC) ;-file data into file 8973.1 (CM HL7 DATA)
+1 ;-----------------------------------------------------------------------
+2 ; KMPDSYNC... 1 - synchronous
+3 ; 2 - asynchronous
+4 ;-----------------------------------------------------------------------
+5 if '$GET(KMPDSYNC)
QUIT
+6 if KMPDSYNC<1!(KMPDSYNC>2)
QUIT
+7 if '$DATA(@GBL1)
QUIT
+8 ;
+9 if '$DATA(ZTQUEUED)
WRITE !,"Filing ",$SELECT(KMPDSYNC=2:"asynchronous",1:"synchronous")," HL7 stats into file 8973.1 (CM HL7 DATA)..."
+10 ;
+11 ; file data
+12 DO @("FILE"_KMPDSYNC)
if '$DATA(FDA)
QUIT
+13 ;
+14 QUIT
+15 ;
FILE1 ;-- file synchronous data
+1 ;
+2 if '$DATA(@GBL1)
QUIT
+3 ;
+4 NEW DATE,ERROR,FDA,I,IEN,INDEX,NM,PT,PT1,ZIEN
+5 ;
+6 SET DATE=0
+7 FOR
SET DATE=$ORDER(@GBL1@(DATE))
if 'DATE
QUIT
SET PT=""
Begin DoDot:1
+8 FOR
SET PT=$ORDER(@GBL1@(DATE,PT))
if PT=""
QUIT
SET NM=""
Begin DoDot:2
+9 ; remove ien (name~123) from protocol
+10 SET PT1=$PIECE(PT,"~")
if PT1=""
QUIT
+11 FOR
SET NM=$ORDER(@GBL1@(DATE,PT,NM))
if NM=""
QUIT
SET ND=0
Begin DoDot:3
+12 KILL ERROR,FDA,IEN,ZIEN
+13 ; determine if data has already been filed (if ien)
+14 SET IEN=$ORDER(^KMPD(8973.1,"APTDTNM",PT1,DATE,NM,0))
+15 ; if filed set IEN="ien," - edit entry
+16 ; if not filed set IEN="+1," - add entry
+17 SET IEN=$SELECT(IEN:IEN_",",1:"+1,")
+18 SET FDA($JOB,8973.1,IEN,.01)=DATE
+19 SET FDA($JOB,8973.1,IEN,.03)=NM
+20 SET FDA($JOB,8973.1,IEN,.05)=PT1
+21 SET FDA($JOB,8973.1,IEN,.06)=1
+22 FOR
SET ND=$ORDER(@GBL1@(DATE,PT,NM,ND))
if 'ND
QUIT
Begin DoDot:4
+23 SET DATA=@GBL1@(DATE,PT,NM,ND)
if DATA=""
QUIT
+24 SET INDEX=$SELECT(ND=99:6,ND=99.2:13,ND=99.5:3,$EXTRACT(ND)=5:24,1:9)
+25 FOR I=1:1:INDEX
if $PIECE(DATA,U,I)'=""
SET FDA($JOB,8973.1,IEN,ND+(I*.001))=$PIECE(DATA,U,I)
End DoDot:4
+26 ; file data
+27 DO UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
+28 ; if error
+29 IF $DATA(ERROR)
Begin DoDot:4
+30 DO MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
+31 DO EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
FILE2 ;-- file asynchronous data
+1 ;
+2 if '$DATA(@GBL1)
QUIT
+3 ;
+4 NEW CF,DATE,ERROR,I,IEN,INDEX1,INDEX2,KMPDERR,NM,PT,PT1,ZIEN
+5 ;
+6 KILL ^TMP($JOB,"KMPDHU03-F2")
+7 SET DATE=0
+8 FOR
SET DATE=$ORDER(@GBL1@(DATE))
if 'DATE
QUIT
SET PT=""
Begin DoDot:1
+9 FOR
SET PT=$ORDER(@GBL1@(DATE,PT))
if PT=""
QUIT
SET NM=""
Begin DoDot:2
+10 ; remove ien (name~123) from protocol
+11 SET PT1=$PIECE(PT,"~")
if PT1=""
QUIT
+12 FOR
SET NM=$ORDER(@GBL1@(DATE,PT,NM))
if NM=""
QUIT
SET CF=""
Begin DoDot:3
+13 FOR
SET CF=$ORDER(@GBL1@(DATE,PT,NM,CF))
if CF=""
QUIT
SET ND=0
Begin DoDot:4
+14 KILL ERROR,IEN,ZIEN,^TMP($JOB,"KMPDHU03-F2"),^TMP($JOB,"KMPDHU03-ERROR")
+15 ; determine if data has already been filed (if ien)
+16 SET IEN=$ORDER(^KMPD(8973.1,"ACSDTPRNM",CF,DATE,PT1,NM,0))
+17 ; if filed set IEN="ien," - edit entry
+18 ; if not filed set IEN="+1," - add entry
+19 SET IEN=$SELECT(IEN:IEN_",",1:"+1,")
+20 ; date
+21 SET ^TMP($JOB,"KMPDHU03-F2",8973.1,IEN,.01)=DATE
+22 ; namespace
+23 SET ^TMP($JOB,"KMPDHU03-F2",8973.1,IEN,.03)=NM
+24 ; protocol
+25 SET ^TMP($JOB,"KMPDHU03-F2",8973.1,IEN,.05)=PT1
+26 ; 2 = asynchronous
+27 SET ^TMP($JOB,"KMPDHU03-F2",8973.1,IEN,.06)=2
+28 FOR
SET ND=$ORDER(@GBL1@(DATE,PT,NM,CF,ND))
if 'ND
QUIT
Begin DoDot:5
+29 SET DATA=@GBL1@(DATE,PT,NM,CF,ND)
if DATA=""
QUIT
+30 ; starting index
+31 ;$S($E(ND)=5:9,1:1)
SET INDEX1=1
+32 ; ending index
+33 SET INDEX2=$SELECT(ND=99:6,ND=99.2:13,ND=99.3:9,ND=99.5:3,$EXTRACT(ND)=5:24,$EXTRACT(ND)=6:24,1:0)
+34 if 'INDEX2
QUIT
+35 FOR I=INDEX1:1:INDEX2
if $PIECE(DATA,U,I)'=""
SET ^TMP($JOB,"KMPDHU03-F2",8973.1,IEN,ND+(I*.001))=$PIECE(DATA,U,I)
End DoDot:5
+36 ;file data
+37 DO UPDATE^DIE("",$NAME(^TMP($JOB,"KMPDHU03-F2")),"ZIEN","ERROR")
+38 ; if error
+39 IF $DATA(ERROR)
Begin DoDot:5
+40 DO MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
+41 DO EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;
+43 KILL ^TMP($JOB,"KMPDHU03-F2")
+44 ;
+45 QUIT
+46 ;
PTNP(DATE) ;-extrinsic function - determine if date.hr is prime time or non-prime time
+1 ;-----------------------------------------------------------------------
+2 ; DATE.... Date.Time in internal FileMan format
+3 ;
+4 ; Return: 1 - prime time
+5 ; 2 - non-prime time
+6 ; "" - unable to identify
+7 ;-----------------------------------------------------------------------
+8 if '$GET(DATE)
QUIT ""
+9 NEW DOW,HOUR
+10 ; day of week in numeric format
+11 SET DOW=$$DOW^XLFDT(DATE,1)
+12 ; hours
+13 SET HOUR=$EXTRACT($PIECE(DATE,".",2),1,2)
+14 ; prime time - not saturday or sunday or holiday and between the hours
+15 ; of 8am (0800) to 5 pm (1700)
+16 if DOW'=0&(DOW'=6)&('$GET(^HOLIDAY($PIECE(DATE,"."),0)))&(HOUR>7)&(HOUR<17)
QUIT 1
+17 ; non-prime time
+18 QUIT 2
