KMPHLMRT ;SP/JML - Collect HL7 Metrics for the VistA HL7 Monitor ;11/1/2023
;;4.0;CAPACITY MANAGEMENT;**1,2,3,4**;3/1/2018;Build 36
;
; Reference to ^HL(D0,0 in ICR #6877
; Reference to ^HLMA(D0,0 in ICR #6878
; Reference to ^HLA(D0,0 in ICR #6882
; Reference to ^HLB(D0,0 in ICR #6883
; Reference to $$WORKDAY^XUWORKDY in ICR #10046
; Reference to $$HTFM^XLFDT in ICR #10103
; Reference to $$FMDIFF^XLFDT in ICR #10103
; Reference to GETENV^%ZOSV, EC^%ZOSV and LGR^%ZOSV in ICR #10097
; Reference to $ESTACK, $ETRAP, ^%ZTER and UNWIND^%ZTER in ICR #1621
;
RUN ;
N $ESTACK,$ETRAP S $ETRAP="D ^ZTER 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,KMPFMDAY
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) ;supported by ICR #10097
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
S KMPPARMS("KMPFMDAY")=+$$HTFM^XLFDT($H,1) ;supported by ICR #10103
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 ^%ZTER 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
N KMPTIEND,KMPSLEN,KMPTLEN,KMPGTLEN,KMPPARTS
;
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"),KMPFMDAY=KMPPARMS("KMPFMDAY"),U="^"
S KMPH=KMPPARMS("KMPH"),KMPSINT=KMPPARMS("KMPSINT")
S KMPINST=KMPPARMS("KMPINST"),KMPNDTYP=KMPPARMS("KMPNDTYP")
S KMPD=$P(KMPH,","),KMPFM=+$$HTFM^XLFDT(KMPH,1) ;supported by ICR #10103
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) ;supported by ICR #10046
;
; HL7 Data
S KMPMDT=KMPSTART,B="|",KMPVLN=1
F S KMPMDT=$O(^HL(772,"B",KMPMDT)) Q:KMPMDT=""!(KMPMDT>=KMPEND) D ;supported by ICR #6877
.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 ;supported by ICR #6878
...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) ;supported by ICR #10103
....S KMPTAA=$$FMDIFF^XLFDT(KMPTAA,KMPTSENT,2) ;supported by ICR #10103
...; 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 ;supported by ICR #6882
.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 ;supported by ICR #6883
...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="",KMPMAX=+$$GETVAL^KMPVCCFG("VHLM","HTTP REQUEST MAX LENGTH",8969)
I KMPMAX=0 S KMPMAX=8000 ; default value
F S KMPHLTYP=$O(^KMPTMP("KMPV","VHLM","TRANSMIT",$J,KMPHLTYP)) Q:KMPHLTYP="" D
.N KMPDARR,KMPJMSG,KMPJSON
.S KMPTI="",KMPTIEND=$O(^KMPTMP("KMPV","VHLM","TRANSMIT",$J,KMPHLTYP,"A"),-1)
.S KMPTLEN=0,KMPGTLEN=0,KMPPARTS=1
.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))
..S KMPSLEN=$L(KMPDATA),KMPGTLEN=KMPGTLEN+KMPSLEN
..I KMPTLEN+KMPSLEN>KMPMAX D
...S KMPJSON.Details=KMPDARR
...S KMPJSON.MessageData.Part="Partial" ; more data lines to send
...S KMPJSON.MessageData.Records=KMPDARR.%Size()
...S KMPJSON.MessageData.Characters=KMPTLEN
...S KMPJSON.MessageData.Message=KMPPARTS,KMPPARTS=KMPPARTS+1
...S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
...I +KMPSTAT'=200 S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
...S ^XTMP("KMP "_KMPFMDAY,"VHLM-"_KMPHLTYP,"HTTP",KMPVNODE,$P($H,",",2))=KMPSTAT
...I +KMPSTAT'=200 D SETRETRY
...; Reset array and counter
...K KMPDARR S KMPDARR=##class(%DynamicArray).%New()
...S KMPTLEN=0
...H 15
..S KMPTLEN=KMPTLEN+KMPSLEN
..D KMPDARR.%Push(KMPDATA)
.; send final message
.S KMPJSON.Details=KMPDARR
.S KMPJSON.MessageData.Part="Final"
.S KMPJSON.MessageData.Records=KMPTIEND
.S KMPJSON.MessageData.Characters=KMPGTLEN
.S KMPJSON.MessageData.Message=KMPPARTS
.S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
.I +KMPSTAT'=200 S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
.S ^XTMP("KMP "_KMPFMDAY,"VHLM-"_KMPHLTYP,"HTTP",KMPVNODE,$P($H,",",2))=KMPSTAT
.I +KMPSTAT'=200 D SETRETRY
K ^KMPTMP("KMPV","VHLM","TRANSMIT",$J)
I $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VHLM COLLECTOR END")
Q
;
SETRETRY ;
N KMPTEXT
S KMPTEXT("SUBJECT")="VSM FAILED SEND: VHLM at "_KMPJSON.Site.SiteCode
S KMPTEXT(1)="Status Code: "_+KMPSTAT
S KMPTEXT(2)="Status Text: "_$P(KMPSTAT,"^",2)
S KMPTEXT(3)="Response Time: "_$P(KMPSTAT,"^",3)
S KMPTEXT(4)="Node: "_KMPVNODE
D INFOMSG^KMPUTLW(.KMPTEXT)
S ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,+$H,$H)=KMPJSON.%ToJSON()
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) ;supported by ICR #10097
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))
..; i kmpjson starts with "file" deal with it and quit
..S KMPSTAT=$$POST^KMPUTLW({}.%FromJSON(KMPJSON),"/hlseven",1,"VHLM")
..I +KMPSTAT=200 K ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI)
..H $R(10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPHLMRT 12758 printed Apr 09, 2024@20:46:38 Page 2
KMPHLMRT ;SP/JML - Collect HL7 Metrics for the VistA HL7 Monitor ;11/1/2023
+1 ;;4.0;CAPACITY MANAGEMENT;**1,2,3,4**;3/1/2018;Build 36
+2 ;
+3 ; Reference to ^HL(D0,0 in ICR #6877
+4 ; Reference to ^HLMA(D0,0 in ICR #6878
+5 ; Reference to ^HLA(D0,0 in ICR #6882
+6 ; Reference to ^HLB(D0,0 in ICR #6883
+7 ; Reference to $$WORKDAY^XUWORKDY in ICR #10046
+8 ; Reference to $$HTFM^XLFDT in ICR #10103
+9 ; Reference to $$FMDIFF^XLFDT in ICR #10103
+10 ; Reference to GETENV^%ZOSV, EC^%ZOSV and LGR^%ZOSV in ICR #10097
+11 ; Reference to $ESTACK, $ETRAP, ^%ZTER and UNWIND^%ZTER in ICR #1621
+12 ;
RUN ;
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ^ZTER 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,KMPFMDAY
+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 ;supported by ICR #10097
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 ;supported by ICR #10103
SET KMPPARMS("KMPFMDAY")=+$$HTFM^XLFDT($HOROLOG,1)
+29 FOR
Begin DoDot:1
+30 ; RUN FLAG SET TO 0
IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969)'="ON"
SET KMPSTOP=1
QUIT
+31 SET KMPH=$HOROLOG
+32 IF KMPH>KMPCHKH
SET KMPSTOP=1
QUIT
+33 SET KMPSINT=$$GETVAL^KMPVCCFG("VHLM","COLLECTION INTERVAL",8969)
+34 SET KMPHANG=KMPSINT*60
+35 SET KMPPARMS("KMPH")=KMPH
SET KMPPARMS("KMPSINT")=KMPSINT
+36 MERGE ^KMPTMP("KMPV","VHLM",KMPVNODE,"PARMS")=KMPPARMS
+37 JOB COLLECT(KMPVNODE)
+38 HANG KMPHANG
End DoDot:1
if KMPSTOP
QUIT
+39 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM DRIVER END")
+40 QUIT
+41 ;
COLLECT(KMPVNODE) ;
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ^%ZTER 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 NEW KMPTIEND,KMPSLEN,KMPTLEN,KMPGTLEN,KMPPARTS
+8 ;
+9 KILL ^KMPTMP("KMPV","VHLM","TRANSMIT")
+10 MERGE KMPPARMS=^KMPTMP("KMPV","VHLM",KMPVNODE,"PARMS")
+11 SET KMPSINF=KMPPARMS("KMPSINF")
+12 SET KMPSC=KMPPARMS("KMPSC")
SET KMPCHKH=KMPPARMS("KMPCHKH")
+13 SET KMPVHSTRT=KMPPARMS("KMPVHSTRT")
SET KMPFMDAY=KMPPARMS("KMPFMDAY")
SET U="^"
+14 SET KMPH=KMPPARMS("KMPH")
SET KMPSINT=KMPPARMS("KMPSINT")
+15 SET KMPINST=KMPPARMS("KMPINST")
SET KMPNDTYP=KMPPARMS("KMPNDTYP")
+16 ;supported by ICR #10103
SET KMPD=$PIECE(KMPH,",")
SET KMPFM=+$$HTFM^XLFDT(KMPH,1)
+17 SET KMPPTIM=$PIECE(KMPH,",",2)-(60*KMPSINT)
+18 SET KMPPH=KMPD_","_KMPPTIM
+19 IF KMPPTIM<0
SET KMPPH=(KMPD-1)_","_(86400-(60*KMPSINT))
+20 SET KMPCSLOT=$$SLOT^KMPVCCFG(KMPH,KMPSINT,"HOROLOG")
+21 SET KMPPSLOT=$$SLOT^KMPVCCFG(KMPPH,KMPSINT,"HOROLOG")
+22 SET %H=KMPD_","_KMPCSLOT
DO YMD^%DTC
SET KMPEND=X_%
+23 SET %H=KMPD_","_KMPPSLOT
DO YMD^%DTC
SET KMPSTART=X_%-.000001
+24 IF KMPPTIM<0
Begin DoDot:1
+25 SET KMPYD=KMPD-1
+26 SET KMPPH=KMPYD_","_(86400-(60*KMPSINT))
+27 SET KMPPSLOT=$$SLOT^KMPVCCFG(KMPPH,KMPSINT,"HOROLOG")
+28 SET %H=KMPYD_","_KMPPSLOT
DO YMD^%DTC
SET KMPSTART=X_%-.000001
End DoDot:1
+29 ;supported by ICR #10046
SET KMPWORK=$$WORKDAY^XUWORKDY(KMPFM)
+30 ;
+31 ; HL7 Data
+32 SET KMPMDT=KMPSTART
SET B="|"
SET KMPVLN=1
+33 ;supported by ICR #6877
FOR
SET KMPMDT=$ORDER(^HL(772,"B",KMPMDT))
if KMPMDT=""!(KMPMDT>=KMPEND)
QUIT
Begin DoDot:1
+34 SET KMPI772=0
+35 FOR
SET KMPI772=$ORDER(^HL(772,"B",KMPMDT,KMPI772))
if KMPI772=""
QUIT
Begin DoDot:2
+36 SET KMPI773=""
+37 ;supported by ICR #6878
FOR
SET KMPI773=$ORDER(^HLMA("B",KMPI772,KMPI773))
if KMPI773=""
QUIT
Begin DoDot:3
+38 SET KMPMA0=$GET(^HLMA(KMPI773,0))
SET KMPMSH=$GET(^HLMA(KMPI773,"MSH",1,0))
+39 SET KMPMAS=$GET(^HLMA(KMPI773,"S"))
SET KMPMAP=$GET(^HLMA(KMPI773,"P"))
+40 SET KMP7720=$GET(^HL(772,KMPI772,0))
SET KMP772S=$GET(^HL(772,KMPI772,"S"))
+41 ; Has parent, Local,parent will be counted
if $PIECE(KMPMA0,"^",6)'=KMPI773
QUIT
+42 ; GET EVENTTIME FROM KMPMDT
+43 SET KMPDTTM=$PIECE(KMP7720,U)
+44 SET KMPTRAN=$PIECE(KMPMA0,U,3)
+45 SET KMPPRI=$PIECE(KMPMA0,U,4)
+46 SET KMPHTYP=$PIECE(KMPMA0,U,5)
IF KMPHTYP=""
SET KMPHTYP=$PIECE(KMP7720,U,14)
+47 SET KMPLL=""
SET KMPIEN=$PIECE(KMPMA0,U,7)
IF KMPIEN'=""
SET KMPLL=$PIECE($GET(^HLCS(870,KMPIEN,0)),U)
+48 SET KMPIEN=$PIECE(KMPMA0,U,8)
SET KMPSPROT=$$GET1^DIQ(101,KMPIEN,.01,"","","")
+49 SET KMPIEN=$PIECE(KMP7720,U,10)
SET KMPEPROT=$$GET1^DIQ(101,KMPIEN,.01,"","","")
+50 SET KMPIEN=$PIECE(KMPMA0,U,13)
SET KMPMTYP=""
IF KMPIEN'=""
SET KMPMTYP=$PIECE($GET(^HL(771.2,KMPIEN,0)),U)
+51 SET KMPIEN=$PIECE(KMPMA0,U,14)
SET KMPETYP=""
IF KMPIEN'=""
SET KMPETYP=$PIECE($GET(^HL(779.001,KMPIEN,0)),U)
+52 ; parse out site info with correct delimiters
+53 SET KMPD1=$EXTRACT(KMPMSH,4)
SET KMPDELS=$PIECE(KMPMSH,KMPD1,2)
SET KMPD2=$EXTRACT(KMPDELS,1)
+54 SET KMPSAPP=$PIECE(KMPMSH,KMPD1,3)
SET KMPRAPP=$PIECE(KMPMSH,KMPD1,5)
+55 SET KMPSEND=$PIECE(KMPMSH,KMPD1,4)
SET KMPSNUM=$PIECE(KMPSEND,KMPD2)
SET KMPSFQDN=$PIECE(KMPSEND,KMPD2,2)
SET KMPSDNS=$PIECE(KMPSEND,KMPD2,3)
+56 ;_"~"_KMPSDNS
SET KMPSSITE=KMPSNUM_"|"_KMPSFQDN
+57 SET KMPREC=$PIECE(KMPMSH,KMPD1,6)
SET KMPRNUM=$PIECE(KMPREC,KMPD2)
SET KMPRFQDN=$PIECE(KMPREC,KMPD2,2)
SET KMPRDNS=$PIECE(KMPREC,KMPD2,3)
+58 ;_"~"_KMPRDNS
SET KMPRSITE=KMPRNUM_"|"_KMPRFQDN
+59 ;
+60 SET KMPAA=$PIECE(KMPMSH,KMPD1,16)
SET KMPSYNC=$SELECT(KMPAA="AL":"SYNC",1:"ASYNC")
+61 SET KMPNS=$PIECE(KMP7720,U,13)
SET KMPTCHAR=$PIECE(KMP772S,U)+$LENGTH(KMPMSH)
+62 SET KMPTEVTS=$PIECE(KMP772S,U,2)
SET KMPTTIME=$PIECE(KMP772S,U,3)
+63 SET (KMPTCA,KMPTAA)=""
+64 SET KMPTSENT=$PIECE(KMPMAS,U,3)
+65 IF KMPTSENT'=""
Begin DoDot:4
+66 SET KMPTCA=$PIECE(KMPMAS,U,4)
SET KMPTAA=$PIECE(KMPMAS,U,5)
+67 ;supported by ICR #10103
SET KMPTCA=$$FMDIFF^XLFDT(KMPTCA,KMPTSENT,2)
+68 ;supported by ICR #10103
SET KMPTAA=$$FMDIFF^XLFDT(KMPTAA,KMPTSENT,2)
End DoDot:4
+69 ; should have all data for normal HL7
+70 SET KMPTS=$$TSTAMP^KMPUTLW(KMPMDT,"FILEMAN",1)
+71 ; NEED SITECODE
+72 SET KMPDATA=KMPSYNC_B_KMPTRAN_B_KMPPRI_B_KMPHTYP_B_KMPLL_B_KMPSPROT_B_KMPEPROT_B_KMPMTYP_B_KMPETYP
+73 SET KMPDATA=KMPDATA_B_KMPSAPP_B_KMPRAPP_B_KMPSSITE_B_KMPRSITE_B_KMPTCHAR_B_KMPTEVTS_B_KMPTTIME_B_KMPTCA_B_KMPTAA_B_B
+74 SET ^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPSYNC,KMPVLN)=KMPDATA
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+75 ; HLO data
+76 SET KMPMDT=KMPSTART
+77 ;supported by ICR #6882
FOR
SET KMPMDT=$ORDER(^HLA("B",KMPMDT))
if KMPMDT=""!(KMPMDT>=KMPEND)
QUIT
Begin DoDot:1
+78 SET KMPHLA=0
+79 FOR
SET KMPHLA=$ORDER(^HLA("B",KMPMDT,KMPHLA))
if KMPHLA=""
QUIT
Begin DoDot:2
+80 SET KMPHLB=""
+81 ;supported by ICR #6883
FOR
SET KMPHLB=$ORDER(^HLB("C",KMPHLA,KMPHLB))
if KMPHLB=""
QUIT
Begin DoDot:3
+82 SET KMPHLA0=$GET(^HLA(KMPHLA,0))
+83 SET KMPHLB0=$GET(^HLB(KMPHLB,0))
+84 ;
+85 ; CALCULATE TOTAL LENGTH OF MESSAGE BODY
SET KMPMLEN=0
SET KI=0
+86 FOR
SET KI=$ORDER(^HLA(KMPHLA,1,KI))
if KI=""
QUIT
SET KMPMLEN=KMPMLEN+$LENGTH(^HLA(KMPHLA,1,KI,0))
+87 SET KMPMSH=^HLB(KMPHLB,1)_^HLB(KMPHLB,2)
+88 SET KMPTLEN=KMPMLEN+$LENGTH(KMPMSH)
+89 ; fields from HLA - (required)
+90 SET KMPADT=$PIECE(KMPHLA0,"^")
SET KMPAMTYP=$PIECE(KMPHLA0,"^",3)
SET KMPAMEVT=$PIECE(KMPHLA0,"^",4)
+91 ; fields from HLB
+92 SET KMPTYP=$SELECT($PIECE(KMPHLB0,"^",3)="":"PRIME",1:"ACK")
+93 SET KMPDIR=$PIECE(KMPHLB0,"^",4)
SET KMPLL=$PIECE(KMPHLB0,"^",5)
SET KMPQUE=$PIECE(KMPHLB0,"^",6)
+94 ; fields from MSH Header
+95 SET KMPD1=$EXTRACT(KMPMSH,4)
SET KMPDELS=$PIECE(KMPMSH,KMPD1,2)
SET KMPD2=$EXTRACT(KMPDELS,1)
+96 SET KMPSAPP=$PIECE(KMPMSH,KMPD1,3)
SET KMPRAPP=$PIECE(KMPMSH,KMPD1,5)
+97 ; parse out site info with correct delimiters
+98 SET KMPSEND=$PIECE(KMPMSH,KMPD1,4)
SET KMPSNUM=$PIECE(KMPSEND,KMPD2)
SET KMPSFQDN=$PIECE(KMPSEND,KMPD2,2)
SET KMPSDNS=$PIECE(KMPSEND,KMPD2,3)
+99 ;_"~"_KMPSDNS
SET KMPSSITE=KMPSNUM_B_KMPSFQDN
+100 SET KMPREC=$PIECE(KMPMSH,KMPD1,6)
SET KMPRNUM=$PIECE(KMPREC,KMPD2)
SET KMPRFQDN=$PIECE(KMPREC,KMPD2,2)
SET KMPRDNS=$PIECE(KMPREC,KMPD2,3)
+101 ;_"~"_KMPRDNS
SET KMPRSITE=KMPRNUM_B_KMPRFQDN
+102 SET KMPAA=$PIECE(KMPMSH,KMPD1,16)
SET KMPSYNC=$SELECT(KMPAA="AL":"SYNCH",1:"ASYNC")
+103 SET KMPTS=$$TSTAMP^KMPUTLW(KMPMDT,"FILEMAN",1)
+104 SET KMPDATA=KMPSYNC_B_KMPDIR_B_B_B_KMPLL_B_B_B_KMPAMTYP_B_KMPAMEVT
+105 SET KMPDATA=KMPDATA_B_KMPSAPP_B_KMPRAPP_B_KMPSSITE_B_KMPRSITE_B_KMPMLEN_B_B_B_B_B_KMPTYP_B_KMPQUE
+106 SET ^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,"HLO",KMPVLN)=KMPDATA
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+107 ; quit if no data to transmit.
+108 IF '$DATA(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB))
Begin DoDot:1
+109 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM COLLECTOR END")
End DoDot:1
QUIT
+110 ; yyy-mm-dd hh:mm:ssZts
SET KMPTIMES=$$TSTAMP^KMPUTLW(KMPD_","_KMPCSLOT,"HOROLOG",1)
+111 SET KMPHLTYP=""
SET KMPMAX=+$$GETVAL^KMPVCCFG("VHLM","HTTP REQUEST MAX LENGTH",8969)
+112 ; default value
IF KMPMAX=0
SET KMPMAX=8000
+113 FOR
SET KMPHLTYP=$ORDER(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP))
if KMPHLTYP=""
QUIT
Begin DoDot:1
+114 NEW KMPDARR,KMPJMSG,KMPJSON
+115 SET KMPTI=""
SET KMPTIEND=$ORDER(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP,"A"),-1)
+116 SET KMPTLEN=0
SET KMPGTLEN=0
SET KMPPARTS=1
+117 SET KMPJSON=##class(%DynamicObject).%New()
+118 SET KMPJSON.Function="VHLM"
+119 DO SITE^KMPUTLW(KMPJSON)
+120 SET KMPJMSG=##class(%DynamicObject).%New()
+121 SET KMPJMSG.Timestamp=$PIECE(KMPTIMES,"^")
SET KMPJMSG.UtcOdbc=$PIECE(KMPTIMES,"^",2)
+122 SET KMPJMSG.UtcEpoch=$PIECE(KMPTIMES,"^",3)
SET KMPJMSG.IsDst=$PIECE(KMPTIMES,"^",4)
+123 SET KMPJMSG.Workday=KMPWORK
SET KMPJMSG.Instance=KMPINST
+124 SET KMPJMSG.Node=$PIECE(KMPVNODE,":")
SET KMPJMSG.NodeType=KMPNDTYP
+125 SET KMPJMSG.Hl7Type=KMPHLTYP
SET KMPJMSG.Date=$$SHORTDAT^KMPUTLW(KMPD,"HOROLOG")
+126 SET KMPJSON.MessageData=KMPJMSG
+127 SET KMPDARR=##class(%DynamicArray).%New()
+128 FOR
SET KMPTI=$ORDER(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP,KMPTI))
if KMPTI=""
QUIT
Begin DoDot:2
+129 SET KMPDATA=$GET(^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB,KMPHLTYP,KMPTI))
+130 SET KMPSLEN=$LENGTH(KMPDATA)
SET KMPGTLEN=KMPGTLEN+KMPSLEN
+131 IF KMPTLEN+KMPSLEN>KMPMAX
Begin DoDot:3
+132 SET KMPJSON.Details=KMPDARR
+133 ; more data lines to send
SET KMPJSON.MessageData.Part="Partial"
+134 SET KMPJSON.MessageData.Records=KMPDARR.%Size()
+135 SET KMPJSON.MessageData.Characters=KMPTLEN
+136 SET KMPJSON.MessageData.Message=KMPPARTS
SET KMPPARTS=KMPPARTS+1
+137 SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
+138 IF +KMPSTAT'=200
SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
+139 SET ^XTMP("KMP "_KMPFMDAY,"VHLM-"_KMPHLTYP,"HTTP",KMPVNODE,$PIECE($HOROLOG,",",2))=KMPSTAT
+140 IF +KMPSTAT'=200
DO SETRETRY
+141 ; Reset array and counter
+142 KILL KMPDARR
SET KMPDARR=##class(%DynamicArray).%New()
+143 SET KMPTLEN=0
+144 HANG 15
End DoDot:3
+145 SET KMPTLEN=KMPTLEN+KMPSLEN
+146 DO KMPDARR.%Push(KMPDATA)
End DoDot:2
+147 ; send final message
+148 SET KMPJSON.Details=KMPDARR
+149 SET KMPJSON.MessageData.Part="Final"
+150 SET KMPJSON.MessageData.Records=KMPTIEND
+151 SET KMPJSON.MessageData.Characters=KMPGTLEN
+152 SET KMPJSON.MessageData.Message=KMPPARTS
+153 SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
+154 IF +KMPSTAT'=200
SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/hlseven",1,"VHLM")
+155 SET ^XTMP("KMP "_KMPFMDAY,"VHLM-"_KMPHLTYP,"HTTP",KMPVNODE,$PIECE($HOROLOG,",",2))=KMPSTAT
+156 IF +KMPSTAT'=200
DO SETRETRY
End DoDot:1
+157 KILL ^KMPTMP("KMPV","VHLM","TRANSMIT",$JOB)
+158 IF $$GETVAL^KMPVCCFG("VHLM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VHLM COLLECTOR END")
+159 QUIT
+160 ;
SETRETRY ;
+1 NEW KMPTEXT
+2 SET KMPTEXT("SUBJECT")="VSM FAILED SEND: VHLM at "_KMPJSON.Site.SiteCode
+3 SET KMPTEXT(1)="Status Code: "_+KMPSTAT
+4 SET KMPTEXT(2)="Status Text: "_$PIECE(KMPSTAT,"^",2)
+5 SET KMPTEXT(3)="Response Time: "_$PIECE(KMPSTAT,"^",3)
+6 SET KMPTEXT(4)="Node: "_KMPVNODE
+7 DO INFOMSG^KMPUTLW(.KMPTEXT)
+8 SET ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,+$HOROLOG,$HOROLOG)=KMPJSON.%ToJSON()
+9 QUIT
+10 ;
RETRY ; retry failed POSTS
+1 NEW KMPDAY,KMPI,KMPJSON,KMPSTAT,KMPVNODE,Y
+2 ;
+3 ;supported by ICR #10097
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 ; i kmpjson starts with "file" deal with it and quit
+10 SET KMPSTAT=$$POST^KMPUTLW({}.%FromJSON(KMPJSON),"/hlseven",1,"VHLM")
+11 IF +KMPSTAT=200
KILL ^KMPTMP("KMPV","VHLM","RETRY",KMPVNODE,KMPDAY,KMPI)
+12 HANG $RANDOM(10)
End DoDot:2
End DoDot:1
+13 QUIT
