KMPCSMRT ;SP/JML - Coversheet Timing Data ;11/1/2023
;;4.0;CAPACITY MANAGEMENT;**1,2,3,4**;3/1/2018;Build 36
;
; Reference to $$WORKDAY^XUWORKDY in ICR #10046
; Reference to $$HTFM^XLFDT in ICR #10103
; Reference to $$HDIFF^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("VCSM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VCSM DRIVER")
N KMPDFGBG,KMPDLN,KMPINST,KMPMAP,KMPNDTYP,KMPON,KMPPARMS,KMPSC,KMPVCHKH,KMPFMDAY,KMPVH,KMPVHANG,KMPVNODE,KMPVSINF,KMPVSINT
N KMPVSITE,KMPVSLOT,KMPVSTOP,KMPWORK,KMPVTEST,B,U,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,Y,%
; ALWAYS - verify data is not building past configured number of days - if so for any reason, delete it
D PURGEDLY^KMPVCBG("VCSM")
; Quit if monitor is not turned on
I $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969)'="ON" D Q
.I $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VCSM 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("VCSM","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",$$GETVAL^KMPVCCFG("VTCM","ALLOW TEST SYSTEM",8969,"I")'=1 Q
;
S KMPFMDAY=+$$HTFM^XLFDT($H,1) ;supported by ICR #10103
S KMPWORK=$$WORKDAY^XUWORKDY(KMPFMDAY) ;supported by ICR #10046
S KMPINST=$P(KMPVNODE,":",2),KMPNDTYP=$$NODETYPE^KMPUTLW(KMPINST)
; quit if on front end and ^KMPTMP is mapped to the back end
S KMPMAP=$P(##Class(%SYS.Namespace).GetGlobalDest($ZDEFNSP,"KMPTMP",""),"^",2)
S KMPMAP=$SYSTEM.SQL.UPPER(KMPMAP)
I KMPMAP["SHARE",KMPNDTYP="FE" Q
;
S KMPVSTOP=0,KMPVCHKH=+$H
S KMPPARMS("KMPFMDAY")=KMPFMDAY,KMPPARMS("KMPWORK")=KMPWORK,KMPPARMS("KMPVCHKH")=KMPVCHKH
S KMPPARMS("KMPINST")=KMPINST,KMPPARMS("KMPNDTYP")=KMPNDTYP
F D Q:KMPVSTOP
.S KMPON=$$GETVAL^KMPVCCFG("VCSM","ONOFF",8969)
.I KMPON="ON" S ^KMPTMP("KMPD-CPRS")=1
.E K ^KMPTMP("KMPD-CPRS") S KMPVSTOP=1 Q
.S KMPVH=$H,KMPDLN=1
.I KMPVH>KMPVCHKH SET KMPVSTOP=1 Q
.S KMPVSINT=$$GETVAL^KMPVCCFG("VCSM","COLLECTION INTERVAL",8969)
.S KMPVHANG=KMPVSINT*60
.S KMPPARMS("KMPVH")=KMPVH,KMPPARMS("KMPVSINT")=KMPVSINT
.M ^KMPTMP("KMPV","VCSM",KMPVNODE,"PARMS")=KMPPARMS
.J COLLECT(KMPVNODE)
.H KMPVHANG
I $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VCSM DRIVER END")
Q
;
COLLECT(KMPVNODE) ;
N $ES,$ETRAP S $ETRAP="D ^%ZTER Q"
I $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VCSM COLLECTOR")
N KMPCNT,KMPDATA,KMPDFGBG,KMPDONE,KMPINST,KMPLI,KMPMAX,KMPNDTYP,KMPSTAT,KMPTI,KMPTIMES
N KMPVSINF,KMPVSITE,B,KMPABAND,KMPNOST
;
M KMPPARMS=^KMPTMP("KMPV","VCSM",KMPVNODE,"PARMS")
S KMPFMDAY=KMPPARMS("KMPFMDAY")
S KMPWORK=KMPPARMS("KMPWORK"),KMPVCHKH=KMPPARMS("KMPVCHKH")
S KMPVH=KMPPARMS("KMPVH"),KMPVSINT=KMPPARMS("KMPVSINT")
S KMPINST=KMPPARMS("KMPINST"),KMPNDTYP=KMPPARMS("KMPNDTYP")
S U="^"
S KMPVSLOT=$$SLOT^KMPVCCFG(KMPVH,KMPVSINT,"HOROLOG")
K ^KMPTMP("KMPV","VCSM","TRANSMIT")
;
S KMPDFGBG=0,B="|",KMPDLN=1,KMPABAND=0,KMPNOST=0
I $D(^KMPTMP("KMPDT","ORWCV")) S KMPDFGBG=1
I $D(^KMPTMP("KMPDT","ORWCV-FT")) S KMPDFGBG=KMPDFGBG+2
I KMPDFGBG=1 D ORONE("ORWCV")
I KMPDFGBG=2 D ORONE("ORWCV-FT")
I KMPDFGBG=3 D ORBOTH
;
S KMPTI="",KMPMAX=40000
S KMPLI=+$O(^KMPTMP("KMPV","VCSM","TRANSMIT",""),-1)
I (KMPLI>0)!(KMPABAND>0)!(KMPNOST>0) D
.S KMPDONE=0
.F D Q:KMPDONE
..N KMPJSON,KMPJMSG,KMPDARR
..S KMPJSON=##class(%DynamicObject).%New()
..S KMPJSON.Function="VCSM"
..D SITE^KMPUTLW(KMPJSON)
..S KMPJMSG=##class(%DynamicObject).%New()
..S KMPTIMES=$$TSTAMP^KMPUTLW(+KMPVH_","_KMPVSLOT,"HOROLOG",1) ; yyy-mm-dd hh:mm:ssZtz
..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.Date=$$SHORTDAT^KMPUTLW(+$H,"HOROLOG")
..S KMPJMSG.Node=$P(KMPVNODE,":"),KMPJMSG.NodeType=KMPNDTYP
..S KMPJMSG.Abandoned=KMPABAND,KMPJMSG.NoStartTime=KMPNOST
..S KMPJSON.MessageData=KMPJMSG
..S KMPDARR=##class(%DynamicArray).%New()
..S KMPCNT=0
..F S KMPTI=$O(^KMPTMP("KMPV","VCSM","TRANSMIT",KMPTI)) Q:KMPTI=""!(KMPCNT>KMPMAX) D
...S KMPDATA=$G(^KMPTMP("KMPV","VCSM","TRANSMIT",KMPTI))
...D KMPDARR.%Push(KMPDATA)
...I KMPTI>=KMPLI S KMPDONE=1
...S KMPCNT=KMPCNT+1
..S KMPJSON.Details=KMPDARR
..S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/coversheet",1,"VCSM")
..I +KMPSTAT'=200 H 30 S KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/coversheet",1,"VCSM")
..S ^XTMP("KMP "_KMPFMDAY,"VCSM","HTTP",KMPVNODE,$P($H,",",2))=KMPSTAT
..I +KMPSTAT'=200 D SETRETRY
..I KMPLI=0 S KMPDONE=1 ; just in case there is only abandoned entries. Prevents loop.
.K ^KMPTMP("KMPV","VCSM","TRANSMIT")
I $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I") D RU^%ZOSVKR("KMP VCSM COLLECTOR END")
Q
;
ORONE(KMPDSUB) ;
N KMPBDTIM,KMPDDAT1,KMPDDATA,KMPDDELT,KMPDETS,KMPDID,KMPDP,KMPETIM,KMPVDAY,KMPVTIME,KMPSTIM,KMPETIM,KMPIPOLD,KMPTCHK
;
S KMPTCHK=+$$GETVAL^KMPVCCFG("VCSM","TASKMAN OPTION",8969)
S KMPDID=""
F S KMPDID=$O(^KMPTMP("KMPDT",KMPDSUB,KMPDID)) Q:KMPDID="" D
.S KMPDDAT1=$G(^KMPTMP("KMPDT",KMPDSUB,KMPDID))
.S KMPVDAY=$P($P(KMPDDAT1,U),",",1)
.S KMPVTIME=$P($P(KMPDDAT1,U),",",2)
.I KMPVTIME>=KMPVSLOT,KMPVDAY>=+$H Q
.; FG or BG delta
.S KMPSTIM=$P(KMPDDAT1,U),KMPETIM=$P(KMPDDAT1,U,2)
.I +KMPSTIM=0 D Q ; Initial time not set - count and throw away
..K ^KMPTMP("KMPDT",KMPDSUB,KMPDID)
..S KMPNOST=KMPNOST+1
.; Check if abandoned
.I KMPTCHK>0,$$HDIFF^XLFDT($H,KMPSTIM,2)>(KMPTCHK) D Q ;supported by ICR #10103
..K ^KMPTMP("KMPDT",KMPDSUB,KMPDID)
..S KMPABAND=KMPABAND+1
.Q:KMPETIM="" ; may be still in process
.S KMPDDELT=$$HDIFF^XLFDT(KMPETIM,KMPSTIM,2) ;supported by ICR #10103
.S KMPDP=$S(KMPDSUB="ORWCV-FT":1,1:2)
.S $P(KMPDDATA,B,KMPDP)=KMPDDELT
.; client duz
.S $P(KMPDDATA,B,3)=$P(KMPDDAT1,U,3)
.; ip address
.S $P(KMPDDATA,B,4)=$P(KMPDDAT1,U,4)
.; ip address old
.S KMPIPOLD=$P($P(KMPDID,"-")," ",2)
.I +KMPIPOLD>0 S $P(KMPDDATA,B,5)=KMPIPOLD
.; patient DFN
.S $P(KMPDDATA,B,6)=$P(KMPDID,"-",3)
.; FG DELTA|BG DELTA|CLIENT DUZ|CLIENT IP (was client name)|OLD IP FROM SUBSCRIPT (usually 'No IP Address')|DFN
.S ^KMPTMP("KMPV","VCSM","TRANSMIT",KMPDLN)=KMPDDATA,KMPDLN=KMPDLN+1
.K ^KMPTMP("KMPDT",KMPDSUB,KMPDID)
Q
;
ORBOTH ;
N KMPDBDLT,KMPDBGD,KMPDBGSS,KMPDDATA,KMPDETS,KMPDFDLT,KMPDFGD,KMPDFGSS,KMPDID,KMPVDAY,KMPVTIME
N KMPFGSTIM,KMPFGETIM,KMPBGSTIM,KMPBGETIM,KMPIPOLD,KMPTCHK
; loop foreground node and concurrently look at related background node
S KMPDBGSS="ORWCV",KMPDFGSS="ORWCV-FT"
S KMPTCHK=+$$GETVAL^KMPVCCFG("VCSM","TASKMAN OPTION",8969)
S KMPDID=""
F S KMPDID=$O(^KMPTMP("KMPDT",KMPDFGSS,KMPDID)) Q:KMPDID="" D
.S KMPDFGD=$G(^KMPTMP("KMPDT",KMPDFGSS,KMPDID))
.S KMPDBGD=$G(^KMPTMP("KMPDT",KMPDBGSS,KMPDID))
.S (KMPDFDLT,KMPDBDLT)=""
.S KMPFGSTIM=$P(KMPDFGD,U),KMPFGETIM=$P(KMPDFGD,U,2)
.S KMPBGSTIM=$P(KMPDBGD,U),KMPBGETIM=$P(KMPDBGD,U,2)
.; If start time not set - throw away
.I (+KMPFGSTIM=0)!(+KMPBGSTIM=0) D Q
..K ^KMPTMP("KMPDT",KMPDFGSS,KMPDID)
..K ^KMPTMP("KMPDT",KMPDBGSS,KMPDID)
..S KMPNOST=KMPNOST+1
.; Check if abandoned (no end time after set period
.I KMPTCHK>0,($$HDIFF^XLFDT($H,KMPBGSTIM,2)>(KMPTCHK))!($$HDIFF^XLFDT($H,KMPFGSTIM,2)>(KMPTCHK)) D Q ;supported by ICR #10103
..K ^KMPTMP("KMPDT",KMPDFGSS,KMPDID)
..K ^KMPTMP("KMPDT",KMPDBGSS,KMPDID)
..S KMPABAND=KMPABAND+1
.; if future then skip
.S KMPVDAY=$P($P(KMPDFGD,U),",",1)
.S KMPVTIME=$P($P(KMPDFGD,U),",",2)
.I KMPVTIME>=KMPVSLOT,KMPVDAY>=+$H Q
.; wait for ending time to be set
.I (KMPFGETIM="")!(KMPBGETIM="") Q
.; Data is good so get timings
.I $P(KMPDFGD,U,2) S KMPDFDLT=$$HDIFF^XLFDT(KMPFGETIM,KMPFGSTIM,2) ;supported by ICR #10103
.I $P(KMPDBGD,U,2) S KMPDBDLT=$$HDIFF^XLFDT(KMPBGETIM,KMPBGSTIM,2) ;supported by ICR #10103
.S $P(KMPDDATA,B,1)=KMPDFDLT
.S $P(KMPDDATA,B,2)=KMPDBDLT
.; client duz
.S $P(KMPDDATA,B,3)=$P(KMPDFGD,U,3)
.; client ip
.S $P(KMPDDATA,B,4)=$P(KMPDFGD,U,4)
.; ip address old
.S KMPIPOLD=$P($P(KMPDID,"-")," ",2)
.I KMPIPOLD>0 S $P(KMPDDATA,B,5)=KMPIPOLD
.; patient DFN
.S $P(KMPDDATA,B,6)=$P(KMPDID,"-",3)
.; FG DELTA|BG DELTA|CLIENT DUZ|CLIENT IP (was client name)|OLD IP FROM SUBSCRIPT (usually 'No IP Address')|DFN
.S ^KMPTMP("KMPV","VCSM","TRANSMIT",KMPDLN)=KMPDDATA,KMPDLN=KMPDLN+1
.K ^KMPTMP("KMPDT",KMPDFGSS,KMPDID)
.K ^KMPTMP("KMPDT",KMPDBGSS,KMPDID)
; Loop BG node in case there is an entry that didn't have a FG entry.
; The reverse situation already handled in first loop.
D ORONE("ORWCV")
Q
;
SETRETRY ;
N KMPTEXT
S KMPTEXT("SUBJECT")="VSM FAILED SEND: VCSM 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","VCSM","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","VCSM","RETRY",KMPVNODE,KMPDAY)) Q:KMPDAY="" D
.S KMPI=""
.F S KMPI=$O(^KMPTMP("KMPV","VCSM","RETRY",KMPVNODE,KMPDAY,KMPI)) Q:KMPI="" D
..S KMPJSON=$G(^KMPTMP("KMPV","VCSM","RETRY",KMPVNODE,KMPDAY,KMPI))
..S KMPSTAT=$$POST^KMPUTLW({}.%FromJSON(KMPJSON),"/coversheet",1,"VCSM")
..I +KMPSTAT=200 K ^KMPTMP("KMPV","VCSM","RETRY",KMPVNODE,KMPDAY,KMPI)
..H $R(10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPCSMRT 9919 printed Dec 13, 2024@01:40:29 Page 2
KMPCSMRT ;SP/JML - Coversheet Timing Data ;11/1/2023
+1 ;;4.0;CAPACITY MANAGEMENT;**1,2,3,4**;3/1/2018;Build 36
+2 ;
+3 ; Reference to $$WORKDAY^XUWORKDY in ICR #10046
+4 ; Reference to $$HTFM^XLFDT in ICR #10103
+5 ; Reference to $$HDIFF^XLFDT in ICR #10103
+6 ; Reference to GETENV^%ZOSV, EC^%ZOSV and LGR^%ZOSV in ICR #10097
+7 ; Reference to $ESTACK, $ETRAP, ^%ZTER and UNWIND^%ZTER in ICR #1621
+8 ;
RUN ;
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ^%ZTER Q"
+2 IF $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VCSM DRIVER")
+3 NEW KMPDFGBG,KMPDLN,KMPINST,KMPMAP,KMPNDTYP,KMPON,KMPPARMS,KMPSC,KMPVCHKH,KMPFMDAY,KMPVH,KMPVHANG,KMPVNODE,KMPVSINF,KMPVSINT
+4 NEW KMPVSITE,KMPVSLOT,KMPVSTOP,KMPWORK,KMPVTEST,B,U,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,Y,%
+5 ; ALWAYS - verify data is not building past configured number of days - if so for any reason, delete it
+6 DO PURGEDLY^KMPVCBG("VCSM")
+7 ; Quit if monitor is not turned on
+8 IF $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969)'="ON"
Begin DoDot:1
+9 IF $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VCSM DRIVER END")
End DoDot:1
QUIT
+10 ; Environment Check
+11 ; if TEST system - quit if system is a front end OR allow test=no
+12 ; if PROD system - quit if system is a front end AND allow test=no
+13 SET KMPVTEST=$$GETVAL^KMPVCCFG("VCSM","ALLOW TEST SYSTEM",8969,"I")
+14 ;supported by ICR #10097
DO GETENV^%ZOSV
SET KMPVNODE=$PIECE(Y,U,3)_":"_$PIECE($PIECE(Y,U,4),":",2)
+15 IF $$PROD^KMPVCCFG'="prod"
IF $$GETVAL^KMPVCCFG("VTCM","ALLOW TEST SYSTEM",8969,"I")'=1
QUIT
+16 ;
+17 ;supported by ICR #10103
SET KMPFMDAY=+$$HTFM^XLFDT($HOROLOG,1)
+18 ;supported by ICR #10046
SET KMPWORK=$$WORKDAY^XUWORKDY(KMPFMDAY)
+19 SET KMPINST=$PIECE(KMPVNODE,":",2)
SET KMPNDTYP=$$NODETYPE^KMPUTLW(KMPINST)
+20 ; quit if on front end and ^KMPTMP is mapped to the back end
+21 SET KMPMAP=$PIECE(##Class(%SYS.Namespace).GetGlobalDest($ZDEFNSP,"KMPTMP",""),"^",2)
+22 SET KMPMAP=$SYSTEM.SQL.UPPER(KMPMAP)
+23 IF KMPMAP["SHARE"
IF KMPNDTYP="FE"
QUIT
+24 ;
+25 SET KMPVSTOP=0
SET KMPVCHKH=+$HOROLOG
+26 SET KMPPARMS("KMPFMDAY")=KMPFMDAY
SET KMPPARMS("KMPWORK")=KMPWORK
SET KMPPARMS("KMPVCHKH")=KMPVCHKH
+27 SET KMPPARMS("KMPINST")=KMPINST
SET KMPPARMS("KMPNDTYP")=KMPNDTYP
+28 FOR
Begin DoDot:1
+29 SET KMPON=$$GETVAL^KMPVCCFG("VCSM","ONOFF",8969)
+30 IF KMPON="ON"
SET ^KMPTMP("KMPD-CPRS")=1
+31 IF '$TEST
KILL ^KMPTMP("KMPD-CPRS")
SET KMPVSTOP=1
QUIT
+32 SET KMPVH=$HOROLOG
SET KMPDLN=1
+33 IF KMPVH>KMPVCHKH
SET KMPVSTOP=1
QUIT
+34 SET KMPVSINT=$$GETVAL^KMPVCCFG("VCSM","COLLECTION INTERVAL",8969)
+35 SET KMPVHANG=KMPVSINT*60
+36 SET KMPPARMS("KMPVH")=KMPVH
SET KMPPARMS("KMPVSINT")=KMPVSINT
+37 MERGE ^KMPTMP("KMPV","VCSM",KMPVNODE,"PARMS")=KMPPARMS
+38 JOB COLLECT(KMPVNODE)
+39 HANG KMPVHANG
End DoDot:1
if KMPVSTOP
QUIT
+40 IF $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VCSM DRIVER END")
+41 QUIT
+42 ;
COLLECT(KMPVNODE) ;
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ^%ZTER Q"
+2 IF $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VCSM COLLECTOR")
+3 NEW KMPCNT,KMPDATA,KMPDFGBG,KMPDONE,KMPINST,KMPLI,KMPMAX,KMPNDTYP,KMPSTAT,KMPTI,KMPTIMES
+4 NEW KMPVSINF,KMPVSITE,B,KMPABAND,KMPNOST
+5 ;
+6 MERGE KMPPARMS=^KMPTMP("KMPV","VCSM",KMPVNODE,"PARMS")
+7 SET KMPFMDAY=KMPPARMS("KMPFMDAY")
+8 SET KMPWORK=KMPPARMS("KMPWORK")
SET KMPVCHKH=KMPPARMS("KMPVCHKH")
+9 SET KMPVH=KMPPARMS("KMPVH")
SET KMPVSINT=KMPPARMS("KMPVSINT")
+10 SET KMPINST=KMPPARMS("KMPINST")
SET KMPNDTYP=KMPPARMS("KMPNDTYP")
+11 SET U="^"
+12 SET KMPVSLOT=$$SLOT^KMPVCCFG(KMPVH,KMPVSINT,"HOROLOG")
+13 KILL ^KMPTMP("KMPV","VCSM","TRANSMIT")
+14 ;
+15 SET KMPDFGBG=0
SET B="|"
SET KMPDLN=1
SET KMPABAND=0
SET KMPNOST=0
+16 IF $DATA(^KMPTMP("KMPDT","ORWCV"))
SET KMPDFGBG=1
+17 IF $DATA(^KMPTMP("KMPDT","ORWCV-FT"))
SET KMPDFGBG=KMPDFGBG+2
+18 IF KMPDFGBG=1
DO ORONE("ORWCV")
+19 IF KMPDFGBG=2
DO ORONE("ORWCV-FT")
+20 IF KMPDFGBG=3
DO ORBOTH
+21 ;
+22 SET KMPTI=""
SET KMPMAX=40000
+23 SET KMPLI=+$ORDER(^KMPTMP("KMPV","VCSM","TRANSMIT",""),-1)
+24 IF (KMPLI>0)!(KMPABAND>0)!(KMPNOST>0)
Begin DoDot:1
+25 SET KMPDONE=0
+26 FOR
Begin DoDot:2
+27 NEW KMPJSON,KMPJMSG,KMPDARR
+28 SET KMPJSON=##class(%DynamicObject).%New()
+29 SET KMPJSON.Function="VCSM"
+30 DO SITE^KMPUTLW(KMPJSON)
+31 SET KMPJMSG=##class(%DynamicObject).%New()
+32 ; yyy-mm-dd hh:mm:ssZtz
SET KMPTIMES=$$TSTAMP^KMPUTLW(+KMPVH_","_KMPVSLOT,"HOROLOG",1)
+33 SET KMPJMSG.Timestamp=$PIECE(KMPTIMES,"^")
SET KMPJMSG.UtcOdbc=$PIECE(KMPTIMES,"^",2)
+34 SET KMPJMSG.UtcEpoch=$PIECE(KMPTIMES,"^",3)
SET KMPJMSG.IsDst=$PIECE(KMPTIMES,"^",4)
+35 SET KMPJMSG.Workday=KMPWORK
SET KMPJMSG.Instance=KMPINST
+36 SET KMPJMSG.Date=$$SHORTDAT^KMPUTLW(+$HOROLOG,"HOROLOG")
+37 SET KMPJMSG.Node=$PIECE(KMPVNODE,":")
SET KMPJMSG.NodeType=KMPNDTYP
+38 SET KMPJMSG.Abandoned=KMPABAND
SET KMPJMSG.NoStartTime=KMPNOST
+39 SET KMPJSON.MessageData=KMPJMSG
+40 SET KMPDARR=##class(%DynamicArray).%New()
+41 SET KMPCNT=0
+42 FOR
SET KMPTI=$ORDER(^KMPTMP("KMPV","VCSM","TRANSMIT",KMPTI))
if KMPTI=""!(KMPCNT>KMPMAX)
QUIT
Begin DoDot:3
+43 SET KMPDATA=$GET(^KMPTMP("KMPV","VCSM","TRANSMIT",KMPTI))
+44 DO KMPDARR.%Push(KMPDATA)
+45 IF KMPTI>=KMPLI
SET KMPDONE=1
+46 SET KMPCNT=KMPCNT+1
End DoDot:3
+47 SET KMPJSON.Details=KMPDARR
+48 SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/coversheet",1,"VCSM")
+49 IF +KMPSTAT'=200
HANG 30
SET KMPSTAT=$$POST^KMPUTLW(KMPJSON,"/coversheet",1,"VCSM")
+50 SET ^XTMP("KMP "_KMPFMDAY,"VCSM","HTTP",KMPVNODE,$PIECE($HOROLOG,",",2))=KMPSTAT
+51 IF +KMPSTAT'=200
DO SETRETRY
+52 ; just in case there is only abandoned entries. Prevents loop.
IF KMPLI=0
SET KMPDONE=1
End DoDot:2
if KMPDONE
QUIT
+53 KILL ^KMPTMP("KMPV","VCSM","TRANSMIT")
End DoDot:1
+54 IF $$GETVAL^KMPVCCFG("VCSM","ONOFF",8969,"I")
DO RU^%ZOSVKR("KMP VCSM COLLECTOR END")
+55 QUIT
+56 ;
ORONE(KMPDSUB) ;
+1 NEW KMPBDTIM,KMPDDAT1,KMPDDATA,KMPDDELT,KMPDETS,KMPDID,KMPDP,KMPETIM,KMPVDAY,KMPVTIME,KMPSTIM,KMPETIM,KMPIPOLD,KMPTCHK
+2 ;
+3 SET KMPTCHK=+$$GETVAL^KMPVCCFG("VCSM","TASKMAN OPTION",8969)
+4 SET KMPDID=""
+5 FOR
SET KMPDID=$ORDER(^KMPTMP("KMPDT",KMPDSUB,KMPDID))
if KMPDID=""
QUIT
Begin DoDot:1
+6 SET KMPDDAT1=$GET(^KMPTMP("KMPDT",KMPDSUB,KMPDID))
+7 SET KMPVDAY=$PIECE($PIECE(KMPDDAT1,U),",",1)
+8 SET KMPVTIME=$PIECE($PIECE(KMPDDAT1,U),",",2)
+9 IF KMPVTIME>=KMPVSLOT
IF KMPVDAY>=+$HOROLOG
QUIT
+10 ; FG or BG delta
+11 SET KMPSTIM=$PIECE(KMPDDAT1,U)
SET KMPETIM=$PIECE(KMPDDAT1,U,2)
+12 ; Initial time not set - count and throw away
IF +KMPSTIM=0
Begin DoDot:2
+13 KILL ^KMPTMP("KMPDT",KMPDSUB,KMPDID)
+14 SET KMPNOST=KMPNOST+1
End DoDot:2
QUIT
+15 ; Check if abandoned
+16 ;supported by ICR #10103
IF KMPTCHK>0
IF $$HDIFF^XLFDT($HOROLOG,KMPSTIM,2)>(KMPTCHK)
Begin DoDot:2
+17 KILL ^KMPTMP("KMPDT",KMPDSUB,KMPDID)
+18 SET KMPABAND=KMPABAND+1
End DoDot:2
QUIT
+19 ; may be still in process
if KMPETIM=""
QUIT
+20 ;supported by ICR #10103
SET KMPDDELT=$$HDIFF^XLFDT(KMPETIM,KMPSTIM,2)
+21 SET KMPDP=$SELECT(KMPDSUB="ORWCV-FT":1,1:2)
+22 SET $PIECE(KMPDDATA,B,KMPDP)=KMPDDELT
+23 ; client duz
+24 SET $PIECE(KMPDDATA,B,3)=$PIECE(KMPDDAT1,U,3)
+25 ; ip address
+26 SET $PIECE(KMPDDATA,B,4)=$PIECE(KMPDDAT1,U,4)
+27 ; ip address old
+28 SET KMPIPOLD=$PIECE($PIECE(KMPDID,"-")," ",2)
+29 IF +KMPIPOLD>0
SET $PIECE(KMPDDATA,B,5)=KMPIPOLD
+30 ; patient DFN
+31 SET $PIECE(KMPDDATA,B,6)=$PIECE(KMPDID,"-",3)
+32 ; FG DELTA|BG DELTA|CLIENT DUZ|CLIENT IP (was client name)|OLD IP FROM SUBSCRIPT (usually 'No IP Address')|DFN
+33 SET ^KMPTMP("KMPV","VCSM","TRANSMIT",KMPDLN)=KMPDDATA
SET KMPDLN=KMPDLN+1
+34 KILL ^KMPTMP("KMPDT",KMPDSUB,KMPDID)
End DoDot:1
+35 QUIT
+36 ;
ORBOTH ;
+1 NEW KMPDBDLT,KMPDBGD,KMPDBGSS,KMPDDATA,KMPDETS,KMPDFDLT,KMPDFGD,KMPDFGSS,KMPDID,KMPVDAY,KMPVTIME
+2 NEW KMPFGSTIM,KMPFGETIM,KMPBGSTIM,KMPBGETIM,KMPIPOLD,KMPTCHK
+3 ; loop foreground node and concurrently look at related background node
+4 SET KMPDBGSS="ORWCV"
SET KMPDFGSS="ORWCV-FT"
+5 SET KMPTCHK=+$$GETVAL^KMPVCCFG("VCSM","TASKMAN OPTION",8969)
+6 SET KMPDID=""
+7 FOR
SET KMPDID=$ORDER(^KMPTMP("KMPDT",KMPDFGSS,KMPDID))
if KMPDID=""
QUIT
Begin DoDot:1
+8 SET KMPDFGD=$GET(^KMPTMP("KMPDT",KMPDFGSS,KMPDID))
+9 SET KMPDBGD=$GET(^KMPTMP("KMPDT",KMPDBGSS,KMPDID))
+10 SET (KMPDFDLT,KMPDBDLT)=""
+11 SET KMPFGSTIM=$PIECE(KMPDFGD,U)
SET KMPFGETIM=$PIECE(KMPDFGD,U,2)
+12 SET KMPBGSTIM=$PIECE(KMPDBGD,U)
SET KMPBGETIM=$PIECE(KMPDBGD,U,2)
+13 ; If start time not set - throw away
+14 IF (+KMPFGSTIM=0)!(+KMPBGSTIM=0)
Begin DoDot:2
+15 KILL ^KMPTMP("KMPDT",KMPDFGSS,KMPDID)
+16 KILL ^KMPTMP("KMPDT",KMPDBGSS,KMPDID)
+17 SET KMPNOST=KMPNOST+1
End DoDot:2
QUIT
+18 ; Check if abandoned (no end time after set period
+19 ;supported by ICR #10103
IF KMPTCHK>0
IF ($$HDIFF^XLFDT($HOROLOG,KMPBGSTIM,2)>(KMPTCHK))!($$HDIFF^XLFDT($HOROLOG,KMPFGSTIM,2)>(KMPTCHK))
Begin DoDot:2
+20 KILL ^KMPTMP("KMPDT",KMPDFGSS,KMPDID)
+21 KILL ^KMPTMP("KMPDT",KMPDBGSS,KMPDID)
+22 SET KMPABAND=KMPABAND+1
End DoDot:2
QUIT
+23 ; if future then skip
+24 SET KMPVDAY=$PIECE($PIECE(KMPDFGD,U),",",1)
+25 SET KMPVTIME=$PIECE($PIECE(KMPDFGD,U),",",2)
+26 IF KMPVTIME>=KMPVSLOT
IF KMPVDAY>=+$HOROLOG
QUIT
+27 ; wait for ending time to be set
+28 IF (KMPFGETIM="")!(KMPBGETIM="")
QUIT
+29 ; Data is good so get timings
+30 ;supported by ICR #10103
IF $PIECE(KMPDFGD,U,2)
SET KMPDFDLT=$$HDIFF^XLFDT(KMPFGETIM,KMPFGSTIM,2)
+31 ;supported by ICR #10103
IF $PIECE(KMPDBGD,U,2)
SET KMPDBDLT=$$HDIFF^XLFDT(KMPBGETIM,KMPBGSTIM,2)
+32 SET $PIECE(KMPDDATA,B,1)=KMPDFDLT
+33 SET $PIECE(KMPDDATA,B,2)=KMPDBDLT
+34 ; client duz
+35 SET $PIECE(KMPDDATA,B,3)=$PIECE(KMPDFGD,U,3)
+36 ; client ip
+37 SET $PIECE(KMPDDATA,B,4)=$PIECE(KMPDFGD,U,4)
+38 ; ip address old
+39 SET KMPIPOLD=$PIECE($PIECE(KMPDID,"-")," ",2)
+40 IF KMPIPOLD>0
SET $PIECE(KMPDDATA,B,5)=KMPIPOLD
+41 ; patient DFN
+42 SET $PIECE(KMPDDATA,B,6)=$PIECE(KMPDID,"-",3)
+43 ; FG DELTA|BG DELTA|CLIENT DUZ|CLIENT IP (was client name)|OLD IP FROM SUBSCRIPT (usually 'No IP Address')|DFN
+44 SET ^KMPTMP("KMPV","VCSM","TRANSMIT",KMPDLN)=KMPDDATA
SET KMPDLN=KMPDLN+1
+45 KILL ^KMPTMP("KMPDT",KMPDFGSS,KMPDID)
+46 KILL ^KMPTMP("KMPDT",KMPDBGSS,KMPDID)
End DoDot:1
+47 ; Loop BG node in case there is an entry that didn't have a FG entry.
+48 ; The reverse situation already handled in first loop.
+49 DO ORONE("ORWCV")
+50 QUIT
+51 ;
SETRETRY ;
+1 NEW KMPTEXT
+2 SET KMPTEXT("SUBJECT")="VSM FAILED SEND: VCSM 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","VCSM","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","VCSM","RETRY",KMPVNODE,KMPDAY))
if KMPDAY=""
QUIT
Begin DoDot:1
+6 SET KMPI=""
+7 FOR
SET KMPI=$ORDER(^KMPTMP("KMPV","VCSM","RETRY",KMPVNODE,KMPDAY,KMPI))
if KMPI=""
QUIT
Begin DoDot:2
+8 SET KMPJSON=$GET(^KMPTMP("KMPV","VCSM","RETRY",KMPVNODE,KMPDAY,KMPI))
+9 SET KMPSTAT=$$POST^KMPUTLW({}.%FromJSON(KMPJSON),"/coversheet",1,"VCSM")
+10 IF +KMPSTAT=200
KILL ^KMPTMP("KMPV","VCSM","RETRY",KMPVNODE,KMPDAY,KMPI)
+11 HANG $RANDOM(10)
End DoDot:2
End DoDot:1
+12 QUIT
