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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPHLMRT 10679 printed Jan 19, 2023@21:17:22 Page 2
KMPHLMRT ;SP/JML - Collect hl7 Metrics for the VistA HL7 Monitor ;5/1/2021
+1 ;;4.0;CAPACITY MANAGEMENT;**1,2**;3/1/2018;Build 3
+2 ;
+3 ; Integration Agreements
+4 ; Reference to GETENV^%ZOSV supported by ICR #10097
+5 ; Reference to ^HL(D0,0 supported by ICR #6877
+6 ; Reference to ^HLMA(D0,0 supported by ICR #6878
+7 ; Reference to ^HLA(D0,0 supported by ICR #6882
+8 ; Reference to ^HLB(D0,0 supported by ICR #6883
+9 ; Reference to $$WORKDAY^XUWORKDY supported by ICR #10046
+10 ; Reference to $$HTFM^XLFDT supported by ICR #10103
+11 ; Reference to $$FMDIFF^XLFDT supported by ICR #10103
+12 ;
RUN ;
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^ZU Q"
+2 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM DRIVER")
+3 NEW KMPINST,KMPPARMS,KMPSINT,KMPVTEST,KMPSINT,KMPDAY,KMPVNODE,Y,KMPMT,KMPNDTYP,KMPVHSTRT,KMPH,KMPHANG,KMPSC,KMPSINF,KMPSTOP
+4 NEW ZTDESC,ZTDTH,ZTRTN,ZTSAVE,%,%H,B
+5 SET KMPVHSTRT=$HOROLOG
+6 ; ALWAYS - verify data is not building past configured number of days - if so for any reason, delete it
+7 ;
DO PURGEDLY^KMPVCBG("VHLM")
+8 ; Quit if monitor is not turned on
+9 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969)'="ON"
Begin DoDot:1
+10 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM DRIVER END")
End DoDot:1
QUIT
+11 ; Environment Check
+12 ; if TEST system - quit if system is a front end OR allow test=no
+13 ; if PROD system - quit if system is a front end AND allow test=no
+14 SET KMPVTEST=$$GETVAL^KMPVCCFG("VHLM","ALLOW TEST SYSTEM",8969,"I")
+15 DO GETENV^%ZOSV
SET KMPVNODE=$PIECE(Y,U,3)_":"_$PIECE($PIECE(Y,U,4),":",2)
+16 IF $$PROD^KMPVCCFG'="prod"
IF ($$ISBENODE^KMPVCCFG(KMPVNODE)=0)!(KMPVTEST=0)
QUIT
+17 IF $$PROD^KMPVCCFG="prod"
IF ($$ISBENODE^KMPVCCFG(KMPVNODE)=0)&(KMPVTEST=0)
QUIT
+18 ;
+19 SET U="^"
+20 ; site name^fac num^mail domain^prod/test^site code
SET KMPSINF=$$SITEINFO^KMPVCCFG()
+21 SET KMPSC=$PIECE(KMPSINF,"^",5)
+22 ; Main loop - tasks off collection to keep interval intact
+23 SET KMPSTOP=0
SET KMPCHKH=+$HOROLOG
+24 SET KMPINST=$PIECE(KMPVNODE,":",2)
SET KMPNDTYP=$$NODETYPE^KMPUTLW(KMPINST)
+25 SET KMPPARMS("KMPSINF")=KMPSINF
SET KMPPARMS("KMPVHSTRT")=KMPVHSTRT
+26 SET KMPPARMS("KMPSC")=KMPSC
SET KMPPARMS("KMPCHKH")=KMPCHKH
+27 SET KMPPARMS("KMPINST")=KMPINST
SET KMPPARMS("KMPNDTYP")=KMPNDTYP
+28 FOR
Begin DoDot:1
+29 ; RUN FLAG SET TO 0
IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969)'="ON"
SET KMPSTOP=1
QUIT
+30 SET KMPH=$HOROLOG
+31 IF KMPH>KMPCHKH
SET KMPSTOP=1
QUIT
+32 SET KMPSINT=$$GETVAL^KMPVCCFG("VHLM","COLLECTION INTERVAL",8969)
+33 SET KMPHANG=KMPSINT*60
+34 SET KMPPARMS("KMPH")=KMPH
SET KMPPARMS("KMPSINT")=KMPSINT
+35 MERGE ^KMPTMP("KMPV","VHLM",KMPVNODE,"PARMS")=KMPPARMS
+36 JOB COLLECT(KMPVNODE)
+37 HANG KMPHANG
End DoDot:1
if KMPSTOP
QUIT
+38 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM DRIVER END")
+39 QUIT
+40 ;
COLLECT(KMPVNODE) ;
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^ZU Q"
+2 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM COLLECTOR")
+3 NEW %H,B,KI,KMP7720,KMP772S,KMPAA,KMPADT,KMPAMEVT,KMPAMTYP,KMPCHKH,KMPCNT,KMPCSLOT,KMPD,KMPD1,KMPD2,KMPDARR,KMPDATA,KMPDELS,KMPDIR,KMPDONE,KMPDT,KMPDTTM,KMPEND,KMPEPROT
+4 NEW 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
+5 NEW KMPPH,KMPPRI,KMPPSLOT,KMPPTIM,KMPQUE,KMPRAPP,KMPRDNS,KMPREC,KMPRFQDN,KMPRNUM,KMPRSITE,KMPSAPP,KMPSDNS,KMPSEND,KMPSFQDN,KMPSNUM,KMPSPROT,KMPSSITE,KMPSTART,KMPSTAT
+6 NEW KMPSYNC,KMPTAA,KMPTCA,KMPTCHAR,KMPTEVTS,KMPTI,KMPTIMES,KMPTLEN,KMPTRAN,KMPTS,KMPTSENT,KMPTIME,KMPTTIME,KMPTYP,KMPVLN,KMPWORK,KMPYD,X,KMPNDTYP,KMPINST
+7 ;
+8 KILL ^KMPTMP("KMPV","VHLM","TRANSMIT")
+9 MERGE KMPPARMS=^KMPTMP("KMPV","VHLM",KMPVNODE,"PARMS")
+10 SET KMPSINF=KMPPARMS("KMPSINF")
+11 SET KMPSC=KMPPARMS("KMPSC")
SET KMPCHKH=KMPPARMS("KMPCHKH")
+12 SET KMPVHSTRT=KMPPARMS("KMPVHSTRT")
SET U="^"
+13 SET KMPH=KMPPARMS("KMPH")
SET KMPSINT=KMPPARMS("KMPSINT")
+14 SET KMPINST=KMPPARMS("KMPINST")
SET KMPNDTYP=KMPPARMS("KMPNDTYP")
+15 SET KMPD=$PIECE(KMPH,",")
SET KMPFM=+$$HTFM^XLFDT(KMPH,1)
+16 SET KMPPTIM=$PIECE(KMPH,",",2)-(60*KMPSINT)
+17 SET KMPPH=KMPD_","_KMPPTIM
+18 IF KMPPTIM<0
SET KMPPH=(KMPD-1)_","_(86400-(60*KMPSINT))
+19 SET KMPCSLOT=$$SLOT^KMPVCCFG(KMPH,KMPSINT,"HOROLOG")
+20 SET KMPPSLOT=$$SLOT^KMPVCCFG(KMPPH,KMPSINT,"HOROLOG")
+21 SET %H=KMPD_","_KMPCSLOT
DO YMD^%DTC
SET KMPEND=X_%
+22 SET %H=KMPD_","_KMPPSLOT
DO YMD^%DTC
SET KMPSTART=X_%-.000001
+23 IF KMPPTIM<0
Begin DoDot:1
+24 SET KMPYD=KMPD-1
+25 SET KMPPH=KMPYD_","_(86400-(60*KMPSINT))
+26 SET KMPPSLOT=$$SLOT^KMPVCCFG(KMPPH,KMPSINT,"HOROLOG")
+27 SET %H=KMPYD_","_KMPPSLOT
DO YMD^%DTC
SET KMPSTART=X_%-.000001
End DoDot:1
+28 SET KMPWORK=$$WORKDAY^XUWORKDY(KMPFM)
+29 ;
+30 ; HL7 Data
+31 SET KMPMDT=KMPSTART
SET B="|"
SET KMPVLN=1
+32 FOR
SET KMPMDT=$ORDER(^HL(772,"B",KMPMDT))
if KMPMDT=""!(KMPMDT>=KMPEND)
QUIT
Begin DoDot:1
+33 SET KMPI772=0
+34 FOR
SET KMPI772=$ORDER(^HL(772,"B",KMPMDT,KMPI772))
if KMPI772=""
QUIT
Begin DoDot:2
+35 SET KMPI773=""
+36 FOR
SET KMPI773=$ORDER(^HLMA("B",KMPI772,KMPI773))
if KMPI773=""
QUIT
Begin DoDot:3
+37 SET KMPMA0=$GET(^HLMA(KMPI773,0))
SET KMPMSH=$GET(^HLMA(KMPI773,"MSH",1,0))
+38 SET KMPMAS=$GET(^HLMA(KMPI773,"S"))
SET KMPMAP=$GET(^HLMA(KMPI773,"P"))
+39 SET KMP7720=$GET(^HL(772,KMPI772,0))
SET KMP772S=$GET(^HL(772,KMPI772,"S"))
+40 ; Has parent, Local,parent will be counted
if $PIECE(KMPMA0,"^",6)'=KMPI773
QUIT
+41 ; GET EVENTTIME FROM KMPMDT
+42 SET KMPDTTM=$PIECE(KMP7720,U)
+43 SET KMPTRAN=$PIECE(KMPMA0,U,3)
+44 SET KMPPRI=$PIECE(KMPMA0,U,4)
+45 SET KMPHTYP=$PIECE(KMPMA0,U,5)
IF KMPHTYP=""
SET KMPHTYP=$PIECE(KMP7720,U,14)
+46 SET KMPLL=""
SET KMPIEN=$PIECE(KMPMA0,U,7)
IF KMPIEN'=""
SET KMPLL=$PIECE($GET(^HLCS(870,KMPIEN,0)),U)
+47 SET KMPIEN=$PIECE(KMPMA0,U,8)
SET KMPSPROT=$$GET1^DIQ(101,KMPIEN,.01,"","","")
+48 SET KMPIEN=$PIECE(KMP7720,U,10)
SET KMPEPROT=$$GET1^DIQ(101,KMPIEN,.01,"","","")
+49 SET KMPIEN=$PIECE(KMPMA0,U,13)
SET KMPMTYP=""
IF KMPIEN'=""
SET KMPMTYP=$PIECE($GET(^HL(771.2,KMPIEN,0)),U)
+50 SET KMPIEN=$PIECE(KMPMA0,U,14)
SET KMPETYP=""
IF KMPIEN'=""
SET KMPETYP=$PIECE($GET(^HL(779.001,KMPIEN,0)),U)
+51 ; parse out site info with correct delimiters
+52 SET KMPD1=$EXTRACT(KMPMSH,4)
SET KMPDELS=$PIECE(KMPMSH,KMPD1,2)
SET KMPD2=$EXTRACT(KMPDELS,1)
+53 SET KMPSAPP=$PIECE(KMPMSH,KMPD1,3)
SET KMPRAPP=$PIECE(KMPMSH,KMPD1,5)
+54 SET KMPSEND=$PIECE(KMPMSH,KMPD1,4)
SET KMPSNUM=$PIECE(KMPSEND,KMPD2)
SET KMPSFQDN=$PIECE(KMPSEND,KMPD2,2)
SET KMPSDNS=$PIECE(KMPSEND,KMPD2,3)
+55 ;_"~"_KMPSDNS
SET KMPSSITE=KMPSNUM_"|"_KMPSFQDN
+56 SET KMPREC=$PIECE(KMPMSH,KMPD1,6)
SET KMPRNUM=$PIECE(KMPREC,KMPD2)
SET KMPRFQDN=$PIECE(KMPREC,KMPD2,2)
SET KMPRDNS=$PIECE(KMPREC,KMPD2,3)
+57 ;_"~"_KMPRDNS
SET KMPRSITE=KMPRNUM_"|"_KMPRFQDN
+58 ;
+59 SET KMPAA=$PIECE(KMPMSH,KMPD1,16)
SET KMPSYNC=$SELECT(KMPAA="AL":"SYNC",1:"ASYNC")
+60 SET KMPNS=$PIECE(KMP7720,U,13)
SET KMPTCHAR=$PIECE(KMP772S,U)+$LENGTH(KMPMSH)
+61 SET KMPTEVTS=$PIECE(KMP772S,U,2)
SET KMPTTIME=$PIECE(KMP772S,U,3)
+62 SET (KMPTCA,KMPTAA)=""
+63 SET KMPTSENT=$PIECE(KMPMAS,U,3)
+64 IF KMPTSENT'=""
Begin DoDot:4
+65 SET KMPTCA=$PIECE(KMPMAS,U,4)
SET KMPTAA=$PIECE(KMPMAS,U,5)
+66 SET KMPTCA=$$FMDIFF^XLFDT(KMPTCA,KMPTSENT,2)
+67 SET KMPTAA=$$FMDIFF^XLFDT(KMPTAA,KMPTSENT,2)
End DoDot:4
+68 ; should have all data for normal HL7
+69 SET KMPTS=$$TSTAMP^KMPUTLW(KMPMDT,"FILEMAN",1)
+70 ; NEED SITECODE
+71 SET KMPDATA=KMPSYNC_B_KMPTRAN_B_KMPPRI_B_KMPHTYP_B_KMPLL_B_KMPSPROT_B_KMPEPROT_B_KMPMTYP_B_KMPETYP
+72 SET KMPDATA=KMPDATA_B_KMPSAPP_B_KMPRAPP_B_KMPSSITE_B_KMPRSITE_B_KMPTCHAR_B_KMPTEVTS_B_KMPTTIME_B_KMPTCA_B_KMPTAA_B_B
+73 SET ^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPSYNC,KMPVLN)=KMPDATA
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+74 ; HLO data
+75 SET KMPMDT=KMPSTART
+76 FOR
SET KMPMDT=$ORDER(^HLA("B",KMPMDT))
if KMPMDT=""!(KMPMDT>=KMPEND)
QUIT
Begin DoDot:1
+77 SET KMPHLA=0
+78 FOR
SET KMPHLA=$ORDER(^HLA("B",KMPMDT,KMPHLA))
if KMPHLA=""
QUIT
Begin DoDot:2
+79 SET KMPHLB=""
+80 FOR
SET KMPHLB=$ORDER(^HLB("C",KMPHLA,KMPHLB))
if KMPHLB=""
QUIT
Begin DoDot:3
+81 SET KMPHLA0=$GET(^HLA(KMPHLA,0))
+82 SET KMPHLB0=$GET(^HLB(KMPHLB,0))
+83 ;
+84 ; CALCULATE TOTAL LENGTH OF MESSAGE BODY
SET KMPMLEN=0
SET KI=0
+85 FOR
SET KI=$ORDER(^HLA(KMPHLA,1,KI))
if KI=""
QUIT
SET KMPMLEN=KMPMLEN+$LENGTH(^HLA(KMPHLA,1,KI,0))
+86 SET KMPMSH=^HLB(KMPHLB,1)_^HLB(KMPHLB,2)
+87 SET KMPTLEN=KMPMLEN+$LENGTH(KMPMSH)
+88 ; fields from HLA - (required)
+89 SET KMPADT=$PIECE(KMPHLA0,"^")
SET KMPAMTYP=$PIECE(KMPHLA0,"^",3)
SET KMPAMEVT=$PIECE(KMPHLA0,"^",4)
+90 ; fields from HLB
+91 SET KMPTYP=$SELECT($PIECE(KMPHLB0,"^",3)="":"PRIME",1:"ACK")
+92 SET KMPDIR=$PIECE(KMPHLB0,"^",4)
SET KMPLL=$PIECE(KMPHLB0,"^",5)
SET KMPQUE=$PIECE(KMPHLB0,"^",6)
+93 ; fields from MSH Header
+94 SET KMPD1=$EXTRACT(KMPMSH,4)
SET KMPDELS=$PIECE(KMPMSH,KMPD1,2)
SET KMPD2=$EXTRACT(KMPDELS,1)
+95 SET KMPSAPP=$PIECE(KMPMSH,KMPD1,3)
SET KMPRAPP=$PIECE(KMPMSH,KMPD1,5)
+96 ; parse out site info with correct delimiters
+97 SET KMPSEND=$PIECE(KMPMSH,KMPD1,4)
SET KMPSNUM=$PIECE(KMPSEND,KMPD2)
SET KMPSFQDN=$PIECE(KMPSEND,KMPD2,2)
SET KMPSDNS=$PIECE(KMPSEND,KMPD2,3)
+98 ;_"~"_KMPSDNS
SET KMPSSITE=KMPSNUM_B_KMPSFQDN
+99 SET KMPREC=$PIECE(KMPMSH,KMPD1,6)
SET KMPRNUM=$PIECE(KMPREC,KMPD2)
SET KMPRFQDN=$PIECE(KMPREC,KMPD2,2)
SET KMPRDNS=$PIECE(KMPREC,KMPD2,3)
+100 ;_"~"_KMPRDNS
SET KMPRSITE=KMPRNUM_B_KMPRFQDN
+101 SET KMPAA=$PIECE(KMPMSH,KMPD1,16)
SET KMPSYNC=$SELECT(KMPAA="AL":"SYNCH",1:"ASYNC")
+102 SET KMPTS=$$TSTAMP^KMPUTLW(KMPMDT,"FILEMAN",1)
+103 SET KMPDATA=KMPSYNC_B_KMPDIR_B_B_B_KMPLL_B_B_B_KMPAMTYP_B_KMPAMEVT
+104 SET KMPDATA=KMPDATA_B_KMPSAPP_B_KMPRAPP_B_KMPSSITE_B_KMPRSITE_B_KMPMLEN_B_B_B_B_B_KMPTYP_B_KMPQUE
+105 SET ^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,"HLO",KMPVLN)=KMPDATA
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+106 ; quit if no data to transmit.
+107 IF '$DATA(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB))
Begin DoDot:1
+108 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM COLLECTOR END")
End DoDot:1
QUIT
+109 ; yyy-mm-dd hh:mm:ssZts
SET KMPTIMES=$$TSTAMP^KMPUTLW(KMPD_","_KMPCSLOT,"HOROLOG",1)
+110 SET KMPHLTYP=""
+111 FOR
SET KMPHLTYP=$ORDER(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP))
if KMPHLTYP=""
QUIT
Begin DoDot:1
+112 NEW KMPDARR,KMPJMSG,KMPJSON
+113 SET KMPTI=""
+114 SET KMPJSON=##class(%DynamicObject).%New()
+115 SET KMPJSON.Function="VHLM"
+116 DO SITE^KMPUTLW(KMPJSON)
+117 SET KMPJMSG=##class(%DynamicObject).%New()
+118 SET KMPJMSG.Timestamp=$PIECE(KMPTIMES,"^")
SET KMPJMSG.UtcOdbc=$PIECE(KMPTIMES,"^",2)
+119 SET KMPJMSG.UtcEpoch=$PIECE(KMPTIMES,"^",3)
SET KMPJMSG.IsDst=$PIECE(KMPTIMES,"^",4)
+120 SET KMPJMSG.Workday=KMPWORK
SET KMPJMSG.Instance=KMPINST
+121 SET KMPJMSG.Node=$PIECE(KMPVNODE,":")
SET KMPJMSG.NodeType=KMPNDTYP
+122 SET KMPJMSG.Hl7Type=KMPHLTYP
SET KMPJMSG.Date=$$SHORTDAT^KMPUTLW(KMPD,"HOROLOG")
+123 SET KMPJSON.MessageData=KMPJMSG
+124 SET KMPDARR=##class(%DynamicArray).%New()
+125 FOR
SET KMPTI=$ORDER(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP,KMPTI))
if KMPTI=""
QUIT
Begin DoDot:2
+126 SET KMPDATA=$GET(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP,KMPTI))
+127 DO KMPDARR.%Push(KMPDATA)
End DoDot:2
+128 SET KMPJSON.Details=KMPDARR
+129 SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
+130 IF +KMPSTAT'=200
SET ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,+$HOROLOG,$HOROLOG)=KMPJSON.%ToJSON()
End DoDot:1
+131 KILL ^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB)
+132 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM COLLECTOR END")
+133 QUIT
+134 ;
RETRY ; retry failed POSTS
+1 NEW KMPDAY,KMPI,KMPJSON,KMPSTAT,KMPVNODE,Y
+2 ;
+3 DO GETENV^%ZOSV
SET KMPVNODE=$PIECE(Y,"^",3)_":"_$PIECE($PIECE(Y,"^",4),":",2)
+4 SET KMPDAY=""
+5 FOR
SET KMPDAY=$ORDER(^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY))
if KMPDAY=""
QUIT
Begin DoDot:1
+6 SET KMPI=""
+7 FOR
SET KMPI=$ORDER(^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI))
if KMPI=""
QUIT
Begin DoDot:2
+8 SET KMPJSON=$GET(^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI))
+9 SET KMPSTAT=$$POST^KMPUTLW({}.%FromJSON(KMPJSON),"/hlseven",1,"VHLM")
+10 IF +KMPSTAT=200
KILL ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI)
End DoDot:2
End DoDot:1
+11 QUIT
