Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPDHU03

KMPDHU03.m

Go to the documentation of this file. 
  1. KMPDHU03 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04  08:59
  1.  ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1.  ;
  1. COMPILE ;-compile synchronous data into GLB1
  1.  ;-----------------------------------------------------------------------
  1.  ; DATA.... data from GBL array
  1.  ; DATE.... date.hr
  1.  ; ND...... node where data will be filed in file #8973.1
  1.  ; LC...... up-arrow (^) piece location of data to be filed
  1.  ; NM....... namespace
  1.  ; PT...... protocol name~ien
  1.  ; PTNP.... prime time - 1
  1.  ;          non-prime time 2
  1.  ;-----------------------------------------------------------------------
  1.  ;
  1.  N DATA,DATE,I,ND,LC,NM,PT,PTNP
  1.  ;
  1.  Q:'$D(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6))  S DATA=$G(^(SS6)) Q:DATA=""
  1.  ; namespace
  1.  S NM=$S(SS1="HR"!(SS1="PROT"):SS5,SS1="NMSP":SS4,1:"") Q:NM=""
  1.  ; protocol
  1.  S PT=$S(SS1="HR"!(SS1="NMSP"):SS6,SS1="PROT":SS4,1:"") Q:PT=""
  1.  ; prime time - 1, non-prime time - 2
  1.  S DATE=$S(SS1="HR":SS4,SS1="NMSP":SS5,SS1="PROT":SS6,1:"") Q:'DATE
  1.  ; DATE is set by using the 'next highest' hour
  1.  ; 3030509.0811 is returned as 3030509.09
  1.  ; use $$fmadd to go back to previous hour
  1.  S PTNP=$$PTNP^KMPDHU03($$FMADD^XLFDT(DATE,,-1)) Q:'PTNP
  1.  ;
  1.  I SS1="HR" D 
  1.  .S ND=$S(SS2="TM":1,1:""),ND=ND+(PTNP-1)
  1.  .S LC=$S(SS3="T":0,SS3="M":3,SS3="U":6,1:"")
  1.  I SS1="NMSP" D 
  1.  .S ND=$S(SS2="IO":1.1,SS2="LR":1.2,1:""),ND=ND+(PTNP-1)
  1.  .S LC=$S(SS3="I"!(SS3="L"):0,SS3="O"!(SS3="R"):3,SS3="U":6,1:"") Q:LC=""
  1.  I SS1="PROT" D 
  1.  .S ND=99,LC=$S(PTNP=1:0,PTNP=2:3,1:"")
  1.  ;
  1.  ; quit if not node (ND) or location (LC)
  1.  Q:'$P(DATE,".")!('ND)!(LC="")
  1.  ;
  1.  F I=1,3 D 
  1.  .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)
  1.  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)
  1.  ;
  1.  Q
  1.  ;
  1. FILE(KMPDSYNC) ;-file data into file 8973.1 (CM HL7 DATA)
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDSYNC... 1 - synchronous
  1.  ;             2 - asynchronous
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(KMPDSYNC)
  1.  Q:KMPDSYNC<1!(KMPDSYNC>2)
  1.  Q:'$D(@GBL1)
  1.  ;
  1.  W:'$D(ZTQUEUED) !,"Filing ",$S(KMPDSYNC=2:"asynchronous",1:"synchronous")," HL7 stats into file 8973.1 (CM HL7 DATA)..."
  1.  ;
  1.  ; file data
  1.  D @("FILE"_KMPDSYNC) Q:'$D(FDA)
  1.  ;
  1.  Q
  1.  ;
  1. FILE1 ;-- file synchronous data
  1.  ;
  1.  Q:'$D(@GBL1)
  1.  ;
  1.  N DATE,ERROR,FDA,I,IEN,INDEX,NM,PT,PT1,ZIEN
  1.  ;
  1.  S DATE=0
  1.  F  S DATE=$O(@GBL1@(DATE)) Q:'DATE  S PT="" D 
  1.  .F  S PT=$O(@GBL1@(DATE,PT)) Q:PT=""  S NM="" D 
  1.  ..; remove ien (name~123) from protocol
  1.  ..S PT1=$P(PT,"~") Q:PT1=""
  1.  ..F  S NM=$O(@GBL1@(DATE,PT,NM)) Q:NM=""  S ND=0 D 
  1.  ...K ERROR,FDA,IEN,ZIEN
  1.  ...; determine if data has already been filed (if ien)
  1.  ...S IEN=$O(^KMPD(8973.1,"APTDTNM",PT1,DATE,NM,0))
  1.  ...;     if filed set IEN="ien," - edit entry
  1.  ...; if not filed set IEN="+1," - add entry
  1.  ...S IEN=$S(IEN:IEN_",",1:"+1,")
  1.  ...S FDA($J,8973.1,IEN,.01)=DATE
  1.  ...S FDA($J,8973.1,IEN,.03)=NM
  1.  ...S FDA($J,8973.1,IEN,.05)=PT1
  1.  ...S FDA($J,8973.1,IEN,.06)=1
  1.  ...F  S ND=$O(@GBL1@(DATE,PT,NM,ND)) Q:'ND  D 
  1.  ....S DATA=@GBL1@(DATE,PT,NM,ND) Q:DATA=""
  1.  ....S INDEX=$S(ND=99:6,ND=99.2:13,ND=99.5:3,$E(ND)=5:24,1:9)
  1.  ....F I=1:1:INDEX S:$P(DATA,U,I)'="" FDA($J,8973.1,IEN,ND+(I*.001))=$P(DATA,U,I)
  1.  ...; file data
  1.  ...D UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
  1.  ...; if error
  1.  ...I $D(ERROR) D 
  1.  ....D MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
  1.  ....D EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
  1.  ;
  1.  Q
  1.  ;
  1. FILE2 ;-- file asynchronous data
  1.  ;
  1.  Q:'$D(@GBL1)
  1.  ;
  1.  N CF,DATE,ERROR,I,IEN,INDEX1,INDEX2,KMPDERR,NM,PT,PT1,ZIEN
  1.  ;
  1.  K ^TMP($J,"KMPDHU03-F2")
  1.  S DATE=0
  1.  F  S DATE=$O(@GBL1@(DATE)) Q:'DATE  S PT="" D 
  1.  .F  S PT=$O(@GBL1@(DATE,PT)) Q:PT=""  S NM="" D 
  1.  ..; remove ien (name~123) from protocol
  1.  ..S PT1=$P(PT,"~") Q:PT1=""
  1.  ..F  S NM=$O(@GBL1@(DATE,PT,NM)) Q:NM=""  S CF="" D 
  1.  ...F  S CF=$O(@GBL1@(DATE,PT,NM,CF)) Q:CF=""  S ND=0 D 
  1.  ....K ERROR,IEN,ZIEN,^TMP($J,"KMPDHU03-F2"),^TMP($J,"KMPDHU03-ERROR")
  1.  ....; determine if data has already been filed (if ien)
  1.  ....S IEN=$O(^KMPD(8973.1,"ACSDTPRNM",CF,DATE,PT1,NM,0))
  1.  ....;     if filed set IEN="ien," - edit entry
  1.  ....; if not filed set IEN="+1," - add entry
  1.  ....S IEN=$S(IEN:IEN_",",1:"+1,")
  1.  ....; date
  1.  ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.01)=DATE
  1.  ....; namespace
  1.  ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.03)=NM
  1.  ....; protocol
  1.  ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.05)=PT1
  1.  ....; 2 = asynchronous
  1.  ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.06)=2
  1.  ....F  S ND=$O(@GBL1@(DATE,PT,NM,CF,ND)) Q:'ND  D 
  1.  .....S DATA=@GBL1@(DATE,PT,NM,CF,ND) Q:DATA=""
  1.  .....; starting index
  1.  .....S INDEX1=1 ;$S($E(ND)=5:9,1:1)
  1.  .....; ending index
  1.  .....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)
  1.  .....Q:'INDEX2
  1.  .....F I=INDEX1:1:INDEX2 S:$P(DATA,U,I)'="" ^TMP($J,"KMPDHU03-F2",8973.1,IEN,ND+(I*.001))=$P(DATA,U,I)
  1.  ....;file data
  1.  ....D UPDATE^DIE("",$NA(^TMP($J,"KMPDHU03-F2")),"ZIEN","ERROR")
  1.  ....; if error
  1.  ....I $D(ERROR) D 
  1.  .....D MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
  1.  .....D EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
  1.  ;
  1.  K ^TMP($J,"KMPDHU03-F2")
  1.  ;
  1.  Q
  1.  ;
  1. PTNP(DATE) ;-extrinsic function - determine if date.hr is prime time or non-prime time
  1.  ;-----------------------------------------------------------------------
  1.  ; DATE.... Date.Time in internal FileMan format
  1.  ;
  1.  ; Return: 1 - prime time
  1.  ;         2 - non-prime time
  1.  ;        "" - unable to identify
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DATE) ""
  1.  N DOW,HOUR
  1.  ; day of week in numeric format
  1.  S DOW=$$DOW^XLFDT(DATE,1)
  1.  ; hours
  1.  S HOUR=$E($P(DATE,".",2),1,2)
  1.  ; prime time - not saturday or sunday or holiday and between the hours
  1.  ;              of 8am (0800) to 5 pm (1700)
  1.  Q:DOW'=0&(DOW'=6)&('$G(^HOLIDAY($P(DATE,"."),0)))&(HOUR>7)&(HOUR<17) 1
  1.  ; non-prime time
  1.  Q 2