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

KMPHLMRT.m

Go to the documentation of this file.
KMPHLMRT ;SP/JML - Collect hl7 Metrics for the VistA HL7 Monitor ;5/1/2021
 ;;4.0;CAPACITY MANAGEMENT;**1,2**;3/1/2018;Build 3
 ;
 ; Integration Agreements
 ;  Reference to GETENV^%ZOSV supported by ICR #10097
 ;  Reference to ^HL(D0,0 supported by ICR #6877
 ;  Reference to ^HLMA(D0,0 supported by ICR #6878
 ;  Reference to ^HLA(D0,0 supported by ICR #6882
 ;  Reference to ^HLB(D0,0 supported by ICR #6883
 ;  Reference to $$WORKDAY^XUWORKDY supported by ICR #10046
 ;  Reference to $$HTFM^XLFDT supported by ICR #10103
 ;  Reference to $$FMDIFF^XLFDT supported by ICR #10103
 ;
RUN ;
 N $ES,$ETRAP S $ETRAP="D ERR^ZU Q"
 I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM DRIVER")
 N KMPINST,KMPPARMS,KMPSINT,KMPVTEST,KMPSINT,KMPDAY,KMPVNODE,Y,KMPMT,KMPNDTYP,KMPVHSTRT,KMPH,KMPHANG,KMPSC,KMPSINF,KMPSTOP
 N ZTDESC,ZTDTH,ZTRTN,ZTSAVE,%,%H,B
 S KMPVHSTRT=$H
 ; ALWAYS - verify data is not building past configured number of days - if so for any reason, delete it
 D PURGEDLY^KMPVCBG("VHLM") ;
 ; Quit if monitor is not turned on
 I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969)'="ON" D  Q
 .I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM DRIVER END")
 ; Environment Check
 ;   if TEST system - quit if system is a front end OR allow test=no
 ;   if PROD system - quit if system is a front end AND allow test=no
 S KMPVTEST=$$GETVAL^KMPVCCFG("VHLM","ALLOW TEST SYSTEM",8969,"I")
 D GETENV^%ZOSV S KMPVNODE=$P(Y,U,3)_":"_$P($P(Y,U,4),":",2)
 I $$PROD^KMPVCCFG'="prod" I ($$ISBENODE^KMPVCCFG(KMPVNODE)=0)!(KMPVTEST=0) Q
 I $$PROD^KMPVCCFG="prod" I ($$ISBENODE^KMPVCCFG(KMPVNODE)=0)&(KMPVTEST=0) Q
 ;
 S U="^"
 S KMPSINF=$$SITEINFO^KMPVCCFG() ; site name^fac num^mail domain^prod/test^site code
 S KMPSC=$P(KMPSINF,"^",5)
 ; Main loop - tasks off collection to keep interval intact
 S KMPSTOP=0,KMPCHKH=+$H
 S KMPINST=$P(KMPVNODE,":",2),KMPNDTYP=$$NODETYPE^KMPUTLW(KMPINST)
 S KMPPARMS("KMPSINF")=KMPSINF,KMPPARMS("KMPVHSTRT")=KMPVHSTRT
 S KMPPARMS("KMPSC")=KMPSC,KMPPARMS("KMPCHKH")=KMPCHKH
 S KMPPARMS("KMPINST")=KMPINST,KMPPARMS("KMPNDTYP")=KMPNDTYP
 F  D  Q:KMPSTOP
 .I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969)'="ON" S KMPSTOP=1 Q  ; RUN FLAG SET TO 0
 .S KMPH=$H
 .I KMPH>KMPCHKH SET KMPSTOP=1 Q
 .S KMPSINT=$$GETVAL^KMPVCCFG("VHLM","COLLECTION INTERVAL",8969)
 .S KMPHANG=KMPSINT*60
 .S KMPPARMS("KMPH")=KMPH,KMPPARMS("KMPSINT")=KMPSINT
 .M ^KMPTMP("KMPV","VHLM",KMPVNODE,"PARMS")=KMPPARMS
 .J COLLECT(KMPVNODE)
 .H KMPHANG
 I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM DRIVER END")
 Q
 ;
COLLECT(KMPVNODE) ;
 N $ES,$ETRAP S $ETRAP="D ERR^ZU Q"
 I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM COLLECTOR")
 N %H,B,KI,KMP7720,KMP772S,KMPAA,KMPADT,KMPAMEVT,KMPAMTYP,KMPCHKH,KMPCNT,KMPCSLOT,KMPD,KMPD1,KMPD2,KMPDARR,KMPDATA,KMPDELS,KMPDIR,KMPDONE,KMPDT,KMPDTTM,KMPEND,KMPEPROT
 N KMPETYP,KMPFM,KMPH,KMPHLA,KMPHLA0,KMPHLB,KMPHLB0,KMPHLTYP,KMPHTYP,KMPI772,KMPI773,KMPIEN,KMPJMSG,KMPJSON,KMPLI,KMPLL,KMPMA0,KMPMAP,KMPMAS,KMPMAX,KMPMDT,KMPMLEN,KMPMSH,KMPMTYP,KMPNS
 N KMPPH,KMPPRI,KMPPSLOT,KMPPTIM,KMPQUE,KMPRAPP,KMPRDNS,KMPREC,KMPRFQDN,KMPRNUM,KMPRSITE,KMPSAPP,KMPSDNS,KMPSEND,KMPSFQDN,KMPSNUM,KMPSPROT,KMPSSITE,KMPSTART,KMPSTAT
 N KMPSYNC,KMPTAA,KMPTCA,KMPTCHAR,KMPTEVTS,KMPTI,KMPTIMES,KMPTLEN,KMPTRAN,KMPTS,KMPTSENT,KMPTIME,KMPTTIME,KMPTYP,KMPVLN,KMPWORK,KMPYD,X,KMPNDTYP,KMPINST
 ;
 K ^KMPTMP("KMPV","VHLM","TRANSMIT")
 M KMPPARMS=^KMPTMP("KMPV","VHLM",KMPVNODE,"PARMS")
 S KMPSINF=KMPPARMS("KMPSINF")
 S KMPSC=KMPPARMS("KMPSC"),KMPCHKH=KMPPARMS("KMPCHKH")
 S KMPVHSTRT=KMPPARMS("KMPVHSTRT"),U="^"
 S KMPH=KMPPARMS("KMPH"),KMPSINT=KMPPARMS("KMPSINT")
 S KMPINST=KMPPARMS("KMPINST"),KMPNDTYP=KMPPARMS("KMPNDTYP")
 S KMPD=$P(KMPH,","),KMPFM=+$$HTFM^XLFDT(KMPH,1)
 S KMPPTIM=$P(KMPH,",",2)-(60*KMPSINT)
 S KMPPH=KMPD_","_KMPPTIM
 I KMPPTIM<0 S KMPPH=(KMPD-1)_","_(86400-(60*KMPSINT))
 S KMPCSLOT=$$SLOT^KMPVCCFG(KMPH,KMPSINT,"HOROLOG")
 S KMPPSLOT=$$SLOT^KMPVCCFG(KMPPH,KMPSINT,"HOROLOG")
 S %H=KMPD_","_KMPCSLOT D YMD^%DTC S KMPEND=X_%
 S %H=KMPD_","_KMPPSLOT D YMD^%DTC S KMPSTART=X_%-.000001
 I KMPPTIM<0 D
 .S KMPYD=KMPD-1
 .S KMPPH=KMPYD_","_(86400-(60*KMPSINT))
 .S KMPPSLOT=$$SLOT^KMPVCCFG(KMPPH,KMPSINT,"HOROLOG")
 .S %H=KMPYD_","_KMPPSLOT D YMD^%DTC S KMPSTART=X_%-.000001
 S KMPWORK=$$WORKDAY^XUWORKDY(KMPFM)
 ;
 ; HL7 Data
 S KMPMDT=KMPSTART,B="|",KMPVLN=1
 F  S KMPMDT=$O(^HL(772,"B",KMPMDT)) Q:KMPMDT=""!(KMPMDT>=KMPEND)  D
 .S KMPI772=0
 .F  S KMPI772=$O(^HL(772,"B",KMPMDT,KMPI772)) Q:KMPI772=""  D
 ..S KMPI773=""
 ..F  S KMPI773=$O(^HLMA("B",KMPI772,KMPI773)) Q:KMPI773=""  D
 ...S KMPMA0=$G(^HLMA(KMPI773,0)),KMPMSH=$G(^HLMA(KMPI773,"MSH",1,0))
 ...S KMPMAS=$G(^HLMA(KMPI773,"S")),KMPMAP=$G(^HLMA(KMPI773,"P"))
 ...S KMP7720=$G(^HL(772,KMPI772,0)),KMP772S=$G(^HL(772,KMPI772,"S"))
 ...Q:$P(KMPMA0,"^",6)'=KMPI773  ; Has parent, Local,parent will be counted
 ...;   GET EVENTTIME FROM KMPMDT
 ...S KMPDTTM=$P(KMP7720,U)
 ...S KMPTRAN=$P(KMPMA0,U,3)
 ...S KMPPRI=$P(KMPMA0,U,4)
 ...S KMPHTYP=$P(KMPMA0,U,5) I KMPHTYP="" S KMPHTYP=$P(KMP7720,U,14)
 ...S KMPLL="",KMPIEN=$P(KMPMA0,U,7) I KMPIEN'="" S KMPLL=$P($G(^HLCS(870,KMPIEN,0)),U)
 ...S KMPIEN=$P(KMPMA0,U,8),KMPSPROT=$$GET1^DIQ(101,KMPIEN,.01,"","","")
 ...S KMPIEN=$P(KMP7720,U,10),KMPEPROT=$$GET1^DIQ(101,KMPIEN,.01,"","","")
 ...S KMPIEN=$P(KMPMA0,U,13),KMPMTYP="" I KMPIEN'="" S KMPMTYP=$P($G(^HL(771.2,KMPIEN,0)),U)
 ...S KMPIEN=$P(KMPMA0,U,14),KMPETYP="" I KMPIEN'="" S KMPETYP=$P($G(^HL(779.001,KMPIEN,0)),U)
 ...; parse out site info with correct delimiters
 ...S KMPD1=$E(KMPMSH,4),KMPDELS=$P(KMPMSH,KMPD1,2),KMPD2=$E(KMPDELS,1)
 ...S KMPSAPP=$P(KMPMSH,KMPD1,3),KMPRAPP=$P(KMPMSH,KMPD1,5)
 ...S KMPSEND=$P(KMPMSH,KMPD1,4),KMPSNUM=$P(KMPSEND,KMPD2),KMPSFQDN=$P(KMPSEND,KMPD2,2),KMPSDNS=$P(KMPSEND,KMPD2,3)
 ...S KMPSSITE=KMPSNUM_"|"_KMPSFQDN ;_"~"_KMPSDNS
 ...S KMPREC=$P(KMPMSH,KMPD1,6),KMPRNUM=$P(KMPREC,KMPD2),KMPRFQDN=$P(KMPREC,KMPD2,2),KMPRDNS=$P(KMPREC,KMPD2,3)
 ...S KMPRSITE=KMPRNUM_"|"_KMPRFQDN ;_"~"_KMPRDNS
 ...;
 ...S KMPAA=$P(KMPMSH,KMPD1,16),KMPSYNC=$S(KMPAA="AL":"SYNC",1:"ASYNC")
 ...S KMPNS=$P(KMP7720,U,13),KMPTCHAR=$P(KMP772S,U)+$L(KMPMSH)
 ...S KMPTEVTS=$P(KMP772S,U,2),KMPTTIME=$P(KMP772S,U,3)
 ...S (KMPTCA,KMPTAA)=""
 ...S KMPTSENT=$P(KMPMAS,U,3)
 ...I KMPTSENT'="" D
 ....S KMPTCA=$P(KMPMAS,U,4),KMPTAA=$P(KMPMAS,U,5)
 ....S KMPTCA=$$FMDIFF^XLFDT(KMPTCA,KMPTSENT,2)
 ....S KMPTAA=$$FMDIFF^XLFDT(KMPTAA,KMPTSENT,2)
 ...; should have all data for normal HL7
 ...S KMPTS=$$TSTAMP^KMPUTLW(KMPMDT,"FILEMAN",1)
 ...;  NEED SITECODE
 ...S KMPDATA=KMPSYNC_B_KMPTRAN_B_KMPPRI_B_KMPHTYP_B_KMPLL_B_KMPSPROT_B_KMPEPROT_B_KMPMTYP_B_KMPETYP
 ...S KMPDATA=KMPDATA_B_KMPSAPP_B_KMPRAPP_B_KMPSSITE_B_KMPRSITE_B_KMPTCHAR_B_KMPTEVTS_B_KMPTTIME_B_KMPTCA_B_KMPTAA_B_B
 ...S ^KMPTMP("KMPV","VHLM","TRANSMIT",$J,KMPSYNC,KMPVLN)=KMPDATA,KMPVLN=KMPVLN+1
 ; HLO data
 S KMPMDT=KMPSTART
 F  S KMPMDT=$O(^HLA("B",KMPMDT)) Q:KMPMDT=""!(KMPMDT>=KMPEND)  D
 .S KMPHLA=0
 .F  S KMPHLA=$O(^HLA("B",KMPMDT,KMPHLA)) Q:KMPHLA=""  D
 ..S KMPHLB=""
 ..F  S KMPHLB=$O(^HLB("C",KMPHLA,KMPHLB)) Q:KMPHLB=""  D
 ...S KMPHLA0=$G(^HLA(KMPHLA,0))
 ...S KMPHLB0=$G(^HLB(KMPHLB,0))
 ...;
 ...S KMPMLEN=0,KI=0 ; CALCULATE TOTAL LENGTH OF MESSAGE BODY
 ...F  S KI=$O(^HLA(KMPHLA,1,KI)) Q:KI=""  S KMPMLEN=KMPMLEN+$L(^HLA(KMPHLA,1,KI,0))
 ...S KMPMSH=^HLB(KMPHLB,1)_^HLB(KMPHLB,2)
 ...S KMPTLEN=KMPMLEN+$L(KMPMSH)
 ...; fields from HLA - (required) 
 ...S KMPADT=$P(KMPHLA0,"^"),KMPAMTYP=$P(KMPHLA0,"^",3),KMPAMEVT=$P(KMPHLA0,"^",4)
 ...; fields from HLB
 ...S KMPTYP=$S($P(KMPHLB0,"^",3)="":"PRIME",1:"ACK")
 ...S KMPDIR=$P(KMPHLB0,"^",4),KMPLL=$P(KMPHLB0,"^",5),KMPQUE=$P(KMPHLB0,"^",6)
 ...; fields from MSH Header
 ...S KMPD1=$E(KMPMSH,4),KMPDELS=$P(KMPMSH,KMPD1,2),KMPD2=$E(KMPDELS,1)
 ...S KMPSAPP=$P(KMPMSH,KMPD1,3),KMPRAPP=$P(KMPMSH,KMPD1,5)
 ...; parse out site info with correct delimiters
 ...S KMPSEND=$P(KMPMSH,KMPD1,4),KMPSNUM=$P(KMPSEND,KMPD2),KMPSFQDN=$P(KMPSEND,KMPD2,2),KMPSDNS=$P(KMPSEND,KMPD2,3)
 ...S KMPSSITE=KMPSNUM_B_KMPSFQDN ;_"~"_KMPSDNS
 ...S KMPREC=$P(KMPMSH,KMPD1,6),KMPRNUM=$P(KMPREC,KMPD2),KMPRFQDN=$P(KMPREC,KMPD2,2),KMPRDNS=$P(KMPREC,KMPD2,3)
 ...S KMPRSITE=KMPRNUM_B_KMPRFQDN ;_"~"_KMPRDNS
 ...S KMPAA=$P(KMPMSH,KMPD1,16),KMPSYNC=$S(KMPAA="AL":"SYNCH",1:"ASYNC")
 ...S KMPTS=$$TSTAMP^KMPUTLW(KMPMDT,"FILEMAN",1)
 ...S KMPDATA=KMPSYNC_B_KMPDIR_B_B_B_KMPLL_B_B_B_KMPAMTYP_B_KMPAMEVT
 ...S KMPDATA=KMPDATA_B_KMPSAPP_B_KMPRAPP_B_KMPSSITE_B_KMPRSITE_B_KMPMLEN_B_B_B_B_B_KMPTYP_B_KMPQUE
 ...S ^KMPTMP("KMPV","VHLM","TRANSMIT",$J,"HLO",KMPVLN)=KMPDATA,KMPVLN=KMPVLN+1
 ; quit if no data to transmit.
 I '$D(^KMPTMP("KMPV","VHLM","TRANSMIT",$J)) D  Q
 .I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM COLLECTOR END")
 S KMPTIMES=$$TSTAMP^KMPUTLW(KMPD_","_KMPCSLOT,"HOROLOG",1) ; yyy-mm-dd hh:mm:ssZts
 S KMPHLTYP=""
 F  S KMPHLTYP=$O(^KMPTMP("KMPV","VHLM","TRANSMIT",$J,KMPHLTYP)) Q:KMPHLTYP=""  D
 .N KMPDARR,KMPJMSG,KMPJSON
 .S KMPTI=""
 .S KMPJSON=##class(%DynamicObject).%New()
 .S KMPJSON.Function="VHLM"
 .D SITE^KMPUTLW(KMPJSON)
 .S KMPJMSG=##class(%DynamicObject).%New()
 .S KMPJMSG.Timestamp=$P(KMPTIMES,"^"),KMPJMSG.UtcOdbc=$P(KMPTIMES,"^",2)
 .S KMPJMSG.UtcEpoch=$P(KMPTIMES,"^",3),KMPJMSG.IsDst=$P(KMPTIMES,"^",4)
 .S KMPJMSG.Workday=KMPWORK,KMPJMSG.Instance=KMPINST
 .S KMPJMSG.Node=$P(KMPVNODE,":"),KMPJMSG.NodeType=KMPNDTYP
 .S KMPJMSG.Hl7Type=KMPHLTYP,KMPJMSG.Date=$$SHORTDAT^KMPUTLW(KMPD,"HOROLOG")
 .S KMPJSON.MessageData=KMPJMSG
 .S KMPDARR=##class(%DynamicArray).%New()
 .F  S KMPTI=$O(^KMPTMP("KMPV","VHLM","TRANSMIT",$J,KMPHLTYP,KMPTI))  Q:KMPTI=""  D
 ..S KMPDATA=$G(^KMPTMP("KMPV","VHLM","TRANSMIT",$J,KMPHLTYP,KMPTI))
 ..D KMPDARR.%Push(KMPDATA)
 .S KMPJSON.Details=KMPDARR
 .S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
 .I +KMPSTAT'=200 S ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,+$H,$H)=KMPJSON.%ToJSON()
 K ^KMPTMP("KMPV","VHLM","TRANSMIT",$J)
 I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM COLLECTOR END")
 Q
 ;
RETRY ;  retry failed POSTS
 N KMPDAY,KMPI,KMPJSON,KMPSTAT,KMPVNODE,Y
 ;
 D GETENV^%ZOSV S KMPVNODE=$P(Y,"^",3)_":"_$P($P(Y,"^",4),":",2)
 S KMPDAY=""
 F  S KMPDAY=$O(^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY)) Q:KMPDAY=""  D
 .S KMPI=""
 .F  S KMPI=$O(^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI)) Q:KMPI=""  D
 ..S KMPJSON=$G(^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI))
 ..S KMPSTAT=$$POST^KMPUTLW({}.%FromJSON(KMPJSON),"/hlseven",1,"VHLM")
 ..I +KMPSTAT=200 K ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI)
 Q