KMPVCSRV ;SP/JML - VSM Server routine for VistA functions ;5/1/2017
;;4.0;CAPACITY MANAGEMENT;;3/1/2018;Build 38;
;
;
EN ; Server routine entry point
;
Q:'$G(XQMSG)
N XMZ,XMRG,XMER
S XMZ=XQMSG
S XQSUB=$G(XQSUB)
N KMPVCHKF,KMPVFNUM,KMPVFUNC,KMPVRQNAM,KMPVSITE,KMPVSNAME,KMPVTEXT
;
S KMPVFUNC=$P(XQSUB,"^"),KMPVSNAME=$P(XQSUB,"^",2),KMPVFNUM=$P(XQSUB,"^",3),KMPVRQNAM=$P(XQSUB,"^",4)
S KMPVSITE=$$SITE^VASITE ; IA 10112
I KMPVSNAME'=$P(KMPVSITE,"^",2)!(KMPVFNUM'=$P(KMPVSITE,"^",3)) D Q
.S KMPVTEXT="WARN^CLIENT REQUEST LOCATION MISMATCH^"
.S KMPVTEXT(1)="SITE DATA IN EMAIL: "_KMPVSNAME_"^"_KMPVFNUM
.S KMPVTEXT(2)="SITE DATA AT SITE: "_KMPVSITE
.D SUPMSG^KMPVCBG(.KMPVTEXT)
; verify request is for valid function
S KMPVCHKF="^"_KMPVFUNC_"^"
I "^ACK^GETSTAT^RESEND^SETCFG^KMPUPDEF^CTMLOG^PACKUPDT^"'[KMPVCHKF D Q
.S KMPVTEXT="WARN^CLIENT REQUEST INVALID FUNCTION^"
.S KMPVTEXT(1)="FUNCTION REQUEST="_KMPVFUNC
.D SUPMSG^KMPVCBG(.KMPVTEXT)
D @KMPVFUNC
Q
; -- Tasks Via Email Requests --
;
ACK ; Receive acknowledge VSM receipt of VTCM data - delete from local node
N KMPVCDATE,KMPVTSTAT,KMPVMT,KMPPAR1
N XMER,XMRG
; IA #10073
F D REC^XMS3 Q:XMER=-1 D
.I $P(XMRG,"=")="TRANSMISSION STATUS" S KMPVTSTAT=$P(XMRG,"=",2)
.I $P(XMRG,"=")="COLLECTION DATE" S KMPVCDATE=$P(XMRG,"=",2)
.I $P(XMRG,"=")="COLLECTION TYPE" S KMPVMKEY=$P(XMRG,"=",2)
.I $P(XMRG,"=")="PARAM 1" S KMPPAR1=$P(XMRG,"=",2)
Q:KMPVCDATE=""
I KMPVTSTAT="TRANSMISSION RECEIVED" D
.I KMPVMKEY="VTCM" K ^KMPTMP("KMPV","VTCM","DLY",KMPVCDATE)
.I KMPVMKEY="VSTM" K ^KMPTMP("KMPV","VSTM","DLY",KMPVCDATE)
.I KMPVMKEY="VMCM" K ^KMPTMP("KMPV","VMCM","DLY",KMPVCDATE)
.I KMPVMKEY="VBEM" K ^KMPTMP("KMPV","VBEM","COMPRESS",KMPVCDATE)
.I KMPVMKEY="VHLM" K ^KMPTMP("KMPV","VHLM","DLY",KMPVCDATE,KMPPAR1)
Q
;
GETSTAT ; Returns current status of VSM
N KMPVFLD,KMPVFNAM,KMPVLN,KMPVMKEY,KMPVSTAT,KMPVTEXT,KMPVTFLD,KMPVTNUM
D CFGMSG^KMPVCBG("SERVER-VSMSTAT")
Q
;
RESEND ; Resend data for one or more monitors
N KMPVMKEY,KMPVML
N XMER,XMRG
; IA #10073
F D REC^XMS3 Q:XMER=-1 D
.I $P(XMRG,"=")="CollectionType" D
..S KMPVMKEY=$P(XMRG,"=",2)
..I KMPVMKEY'="" S KMPVML(KMPVMKEY)=""
S KMPVMKEY=""
F S KMPVMKEY=$O(KMPVML(KMPVMKEY)) Q:KMPVMKEY="" D
.I KMPVMKEY="VBEM" D EN^KMPVBETR
.I KMPVMKEY="VTCM" D SEND^KMPVVTCM
.I KMPVMKEY="VSTM" D SEND^KMPVVSTM
.I KMPVMKEY="VMCM" D SEND^KMPVVMCM
.I KMPVMKEY="VHLM" D PREPARE^KMPVVHLM
Q
;
SETCFG() ; Change VSM configuration via national server change request
N KMPVCALL,KMPVCFG,KMPVCFGAR,KMPVFVAL,KMPVDATA,KMPVERR,KMPVFNAM,KMPVI,KMPVLN
N KMPVMKEY,KMPVSET,KMPVSTAT,KMPVTEXT,KMPVVAL,KMPVVALID,KMPVEARR
N FDA,XMER,XMRG
;
S KMPVMKEY="NONE"
; Read message text and attempt to update VSM configuration
; IA #10073
F D REC^XMS3 Q:XMER=-1 D
.I $P(XMRG,"=")="MONITOR KEY" S KMPVMKEY=$P(XMRG,"=",2) Q
.Q:$P(XMRG,"=")'="UPDATE KMPCFG"
.S KMPVDATA=$P(XMRG,"=",2)
.S KMPVFNAM=$P(KMPVDATA,"^"),KMPVVAL=$P(KMPVDATA,"^",2)
.S KMPVFVAL(KMPVFNAM)=KMPVVAL
;
; verify Monitor Type is valid
I $D(^KMPV(8969,"B",KMPVMKEY)) S KMPVIEN=$O(^KMPV(8969,"B",KMPVMKEY,""))
I $G(KMPVIEN)="" D Q
.S KMPVTEXT="Monitor "_KMPVMKEY_" not defined"
.S KMPVTEXT(1)="Monitor "_KMPVMKEY_"not defined. No changes made."
.D SUPMSG^KMPVCBG(.KMPVTEXT)
;
; get field numbers and set FDA array
S KMPVFNAM=""
F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
.S KMPVFNUM=$$FLDNUM^DILFD(8969,KMPVFNAM)
.I KMPVFNUM>0 S FDA($J,8969,KMPVIEN_",",KMPVFNUM)=KMPVFVAL(KMPVFNAM)
.E S KMPVEARR(KMPVFNAM)=""
;
; If field name does not exist send message and quit
I $D(KMPVEARR) D Q
.S KMPVTEXT=KMPVMKEY_" Configuration Update: field(s) do not exist"
.S KMPVTEXT(1)="The following field(s) do not exist in the VSM CONFIGURATION file"
.S KMPVFNAM="",KMPVLN=2
.F S KMPVFNAM=$O(KMPVEARR(KMPVFNAM)) Q:KMPVFNAM="" D
..S KMPVTEXT(KMPVLN)=KMPVFNAM,KMPVLN=KMPVLN+1
.D SUPMSG^KMPVCBG(.KMPVTEXT)
;
; If still good get old values for logging changes
S KMPVFNAM=""
F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
.S $P(KMPVFVAL(KMPVFNAM),"^",2)=$$GETVAL^KMPVCCFG(KMPVMKEY,KMPVFNAM,8969,"I")
;
S KMPVLN=1
I $D(KMPVEARR) D Q
.S KMPVTEXT=KMPVMKEY_" Configuration Update: FILING ERRORS - NO CHANGES MADE"
.S KMPVTEXT(KMPVLN)="CONFIGURATION CHANGES NOT APPLIED!",KMPVLN=KMPVLN+1
.S KMPVTEXT(KMPVLN)="ERROR DETAILS: ",KMPVLN=KMPVLN+1
.S KMPVI=""
.F S KMPVI=$O(KMPVEARR(KMPVI)) Q:KMPVI="" D
..S KMPVTEXT(KMPVLN)=KMPVEARR(KMPVI),KMPVLN=KMPVLN+1
.D SUPMSG^KMPVCBG(.KMPVTEXT)
;
; ATTEMPT TO MAKE CHANGES
K KMPVEARR
D FILE^DIE("ET","FDA($J)","KMPVEARR")
; IF ERRORS SEND MESSAGE WITH ERRORS
I $D(KMPVEARR) D ; Add filing errors to support message
.S KMPVTEXT=KMPVMKEY_" Configuration Update: WITH ERRORS"
.S KMPVTEXT(KMPVLN)="Changes NOT applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
.S KMPVTEXT(KMPVLN)="Number of errors: "_+KMPVEARR("DIERR"),KMPVLN=KMPVLN+1
.S KMPVENUM=""
.F S KMPVENUM=$O(KMPVEARR("DIERR",KMPVENUM)) Q:+KMPVENUM=0 D
..S KMPVTNUM=""
..F S KMPVTNUM=$O(KMPVEARR("DIERR",KMPVENUM,"TEXT",KMPVTNUM)) Q:+KMPVTNUM=0 D
...S KMPVTEXT(KMPVLN)=KMPVEARR("DIERR",KMPVENUM,"TEXT",KMPVTNUM),KMPVLN=KMPVLN+1
; If no FILING errors then list changes in Support Message and Log Changes
I '$D(KMPVEARR) D
.S KMPVTEXT=KMPVMKEY_" Configuration Update: No Errors"
.S KMPVTEXT(KMPVLN)="Changes applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
.S KMPVTEXT(KMPVLN)="CHANGED FIELDS:",KMPVLN=KMPVLN+1
.; list changes in Support Message
.S KMPVFNAM=""
.F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
..S KMPVDATA=KMPVFVAL(KMPVFNAM)
..S KMPVTEXT(KMPVLN)=KMPVFNAM_" : "_$P(KMPVDATA,"^",2)_" --> "_$P(KMPVDATA,"^"),KMPVLN=KMPVLN+1
;
; if end state is 'ON' then re-schedule -- if 'OFF' then de-schedule
S KMPVON=$$GETVAL^KMPVCCFG(KMPVMKEY,"ONOFF",8969)
I KMPVON="ON" D STARTMON^KMPVCBG(KMPVMKEY,1)
I KMPVON="OFF" D STOPMON^KMPVCBG(KMPVMKEY,1)
;
; Mail config back to National Server
D CFGMSG^KMPVCBG("SERVER-VSMCFG")
; Mail results back to SUPPORT mail groups
D SUPMSG^KMPVCBG(.KMPVTEXT)
;
Q
;
KMPUPDEF ; Update VSM MONITOR DEFAULTS file. Optionally apply defaults to VSM CONFIGURATION file.
N KMPVADEF,KMPVDATA,KMPVEARR,KMPVENUM,KMPVFNAM,KMPVFVAL,KMPVI,KMPVIEN,KMPVIEN,KMPVLN,KMPVMKEY
N KMPVON,KMPVREST,KMPVTEXT,KMPVTNUM,KMPVVAL
N FDA,XMER,XMRG
;
S KMPVMKEY="NONE"
; Read message text to get data to change
; IA #10073
F D REC^XMS3 Q:XMER=-1 D
.I $P(XMRG,"=")="MONITOR KEY" S KMPVMKEY=$P(XMRG,"=",2) Q
.I $P(XMRG,"=")="APPLY DEFAULTS" S KMPVADEF=$P(XMRG,"=",2) Q
.Q:$P(XMRG,"=")'="UPDATE KMPDEF"
.S KMPVDATA=$P(XMRG,"=",2)
.S KMPVFNAM=$P(KMPVDATA,"^"),KMPVVAL=$P(KMPVDATA,"^",2)
.S KMPVFVAL(KMPVFNAM)=KMPVVAL
;
; verify Monitor Type is valid
I $D(^KMPV(8969.02,"B",KMPVMKEY)) S KMPVIEN=$O(^KMPV(8969.02,"B",KMPVMKEY,""))
I $G(KMPVIEN)="" D Q
.S KMPVTEXT="Monitor "_KMPVMKEY_" not defined"
.S KMPVTEXT(1)="Monitor "_KMPVMKEY_"not defined. No changes made."
.D SUPMSG^KMPVCBG(.KMPVTEXT)
;
; get field numbers and set FDA array
S KMPVFNAM=""
F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
.S KMPVFNUM=$$FLDNUM^DILFD(8969.02,KMPVFNAM)
.I KMPVFNUM>0 S FDA($J,8969.02,KMPVIEN_",",KMPVFNUM)=KMPVFVAL(KMPVFNAM)
.E S KMPVEARR(KMPVFNAM)=""
; If field name does not exist send message and quit
I $D(KMPVEARR) D Q
.S KMPVTEXT=KMPVMKEY_" Default Value Update: field(s) do not exist"
.S KMPVTEXT(1)="The following field(s) do not exist in the VSM MONITOR DEFAULTS file"
.S KMPVFNAM="",KMPVLN=2
.F S KMPVFNAM=$O(KMPVEARR(KMPVFNAM)) Q:KMPVFNAM="" D
..S KMPVTEXT(KMPVLN)=KMPVFNAM,KMPVLN=KMPVLN+1
.D SUPMSG^KMPVCBG(.KMPVTEXT)
;
; If still good get old values for logging changes
S KMPVFNAM=""
F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
.S $P(KMPVFVAL(KMPVFNAM),"^",2)=$$GETVAL^KMPVCCFG(KMPVMKEY,KMPVFNAM,8969.02,"I")
;
; Update VSM MONITOR DEFAULTS file
D FILE^DIE("ET","FDA($J)","KMPVEARR")
;
; If filing errors send message and quit
I $D(KMPVEARR) D Q
.S KMPVTEXT=KMPVMKEY_" Default Value Update: Filing Errors",KMPVLN=1
.S KMPVI=0
.F S KMPVI=$O(KMPVEARR("DIERR",KMPVI)) Q:KMPVI="" D
..S KMPVTNUM=""
..F S KMPVTNUM=$O(KMPVEARR("DIERR",KMPVI,"TEXT",KMPVTNUM)) Q:KMPVTNUM="" D
...S KMPVTEXT(KMPVLN)=KMPVEARR("DIERR",KMPVI,"TEXT",KMPVTNUM),KMPVLN=KMPVLN+1
.D SUPMSG^KMPVCBG(.KMPVTEXT)
;
; If not applying defaults send SUPMSG and quit
I +$G(KMPVADEF)=0 D Q
.S KMPVTEXT=KMPVMKEY_" Default Value Update: Successful"
.S KMPVTEXT(1)="Changes made to VSM MONITOR DEFAULTS file"
.S KMPVTEXT(2)="Changes not applied to VSM CONFIGURATION file"
.D CFGMSG^KMPVCBG("SERVER-VSMUPDEF")
.D SUPMSG^KMPVCBG(.KMPVTEXT)
.
;
; if applying defaults set defaults into VSM CONFIGURATION file
S KMPVLN=1
S KMPVTEXT(KMPVLN)="Changes successfully made to VSM MONITOR DEFAULTS file",KMPVLN=KMPVLN+1
S KMPVSTAT=$$RESTCFG^KMPVCCFG(KMPVMKEY)
I KMPVSTAT=0 D
.S KMPVTEXT=KMPVMKEY_" Default Value Update: No Errors"
.S KMPVTEXT(KMPVLN)="Changes applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
I KMPVSTAT>0 D
.S KMPVTEXT=KMPVMKEY_" Default Value Update: WITH ERRORS"
.S KMPVTEXT(KMPVLN)="Changes NOT applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
;
; if end state is 'ON' then reschedule
S KMPVON=$$GETVAL^KMPVCCFG(KMPVMKEY,"ONOFF",8969)
I KMPVON="ON" D
.D RESCH^KMPVCBG(KMPVMKEY,.KMPVERR)
.I '$D(KMPVERR) S KMPVTEXT(KMPVLN)="Data Transmission task successfully rescheduled",KMPVLN=KMPVLN+1
.I $D(KMPVERR)>0 D
..S KMPVTEXT=KMPVMKEY_" Default Value Update: WITH ERRORS"
..S KMPVTEXT(KMPVLN)="Data Transmission NOT successfully rescheduled",KMPVLN=KMPVLN+1
..S KMPVI=""
..F S KMPVI=$O(KMPVERR(KMPVI)) Q:KMPVI="" D
...S KMPVTEXT(KMPVLN)=KMPVERR(KMPVI),KMPVLN=KMPVLN+1
I KMPVON="OFF" D
.D DESCH^KMPVCBG(KMPVMKEY,.KMPVERR)
.S KMPVTEXT(KMPVLN)="Data Transmission task successfully unscheduled",KMPVLN=KMPVLN+1
.I $D(KMPVERR)>0 D
..S KMPVTEXT=KMPVMKEY_" Configuration Update: WITH ERRORS"
..S KMPVTEXT(KMPVLN-1)="Data Transmission NOT successfully unscheduled",KMPVLN=KMPVLN+1
..S KMPVI=""
..F S KMPVI=$O(KMPVERR(KMPVI)) Q:KMPVI="" D
...S KMPVTEXT(KMPVLN)=KMPVERR(KMPVI),KMPVLN=KMPVLN+1
;
D SUPMSG^KMPVCBG(.KMPVTEXT)
Q
;
CTMLOG ; Return run history recorded in the VSM CACHE TASK LOG file
N KMPVMKEY,KMPVML,KMPVTEXT
N XMER
;
S KMPVIEN=0,KMPVLN=1
S KMPVTEXT(KMPVLN)="Raw data from VSM CACHE TASK LOG file",KMPVLN=KMPVLN+1
F S KMPVIEN=$O(^KMPV(8969.03,KMPVIEN)) Q:+KMPVIEN=0 D
.S KMPVDATA=$G(^KMPV(8969.03,KMPVIEN,0))
.S KMPVTEXT(KMPVLN)=KMPVDATA,KMPVLN=KMPVLN+1
S KMPVTEXT="Task Manager Run History for "_KMPVSITE
D DBAMSG^KMPVCBG(.KMPVTEXT)
Q
;
PACKUPDT ; Get data from PACKAGE file
N KMPVCNAM,KMPVCNS,KMPVDOM,KMPVEMAIL,KMPVIEN,KMPVIEN2,KMPVLN,KMPVPDATA,KMPVPNAM,KMPVPNS,KMPVPRE,KMPVPROD,KMPVSCD,KMPVSINF
N X,XMSUB,XMTEXT,XMY,XMZ,Y
S KMPVPROD=$$PROD^KMPVCCFG()
S KMPVDOM=$P($$NETNAME^XMXUTIL(.5),"@",2) ;IA 2734
S KMPVSITE=$$SITE^VASITE ; IA 10112
D GETENV^%ZOSV S KMPVSCD=$P(Y,U,1) ; IA 10097
S KMPVSINF=$$SITEINFO^KMPVCCFG()
S XMSUB="VBEMPACK"
S KMPVPRE="",KMPVLN=1
S KMPVTEXT(KMPVLN)="SYSTEM ID="_KMPVSINF,KMPVLN=KMPVLN+1
F S KMPVPRE=$O(^DIC(9.4,"C",KMPVPRE)) Q:KMPVPRE="" D
.S KMPVIEN=""
.; NO WAY TO DECIDE WHICH IS CORRECT SO TAKE FIRST - DON'T LOOP
.S KMPVIEN=$O(^DIC(9.4,"C",KMPVPRE,KMPVIEN)) Q:KMPVIEN="" D
..S KMPVPNAM=$P($G(^DIC(9.4,KMPVIEN,0)),"^") ;,KMPVCNAM=KMPVPNAM
..S KMPVTEXT(KMPVLN)="PACKINFO="_KMPVPRE_"^"_KMPVPNAM,KMPVLN=KMPVLN+1
S XMTEXT=$S($D(KMPVTEXT):"KMPVTEXT(",1:"No package data collected")
S KMPVEMAIL=$$GETVAL^KMPVCCFG("VBEM","VSM CFG EMAIL ADDRESS",8969) I KMPVEMAIL'="" S XMY(KMPVEMAIL)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPVCSRV 11933 printed Apr 09, 2024@20:45:58 Page 2
KMPVCSRV ;SP/JML - VSM Server routine for VistA functions ;5/1/2017
+1 ;;4.0;CAPACITY MANAGEMENT;;3/1/2018;Build 38;
+2 ;
+3 ;
EN ; Server routine entry point
+1 ;
+2 if '$GET(XQMSG)
QUIT
+3 NEW XMZ,XMRG,XMER
+4 SET XMZ=XQMSG
+5 SET XQSUB=$GET(XQSUB)
+6 NEW KMPVCHKF,KMPVFNUM,KMPVFUNC,KMPVRQNAM,KMPVSITE,KMPVSNAME,KMPVTEXT
+7 ;
+8 SET KMPVFUNC=$PIECE(XQSUB,"^")
SET KMPVSNAME=$PIECE(XQSUB,"^",2)
SET KMPVFNUM=$PIECE(XQSUB,"^",3)
SET KMPVRQNAM=$PIECE(XQSUB,"^",4)
+9 ; IA 10112
SET KMPVSITE=$$SITE^VASITE
+10 IF KMPVSNAME'=$PIECE(KMPVSITE,"^",2)!(KMPVFNUM'=$PIECE(KMPVSITE,"^",3))
Begin DoDot:1
+11 SET KMPVTEXT="WARN^CLIENT REQUEST LOCATION MISMATCH^"
+12 SET KMPVTEXT(1)="SITE DATA IN EMAIL: "_KMPVSNAME_"^"_KMPVFNUM
+13 SET KMPVTEXT(2)="SITE DATA AT SITE: "_KMPVSITE
+14 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+15 ; verify request is for valid function
+16 SET KMPVCHKF="^"_KMPVFUNC_"^"
+17 IF "^ACK^GETSTAT^RESEND^SETCFG^KMPUPDEF^CTMLOG^PACKUPDT^"'[KMPVCHKF
Begin DoDot:1
+18 SET KMPVTEXT="WARN^CLIENT REQUEST INVALID FUNCTION^"
+19 SET KMPVTEXT(1)="FUNCTION REQUEST="_KMPVFUNC
+20 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+21 DO @KMPVFUNC
+22 QUIT
+23 ; -- Tasks Via Email Requests --
+24 ;
ACK ; Receive acknowledge VSM receipt of VTCM data - delete from local node
+1 NEW KMPVCDATE,KMPVTSTAT,KMPVMT,KMPPAR1
+2 NEW XMER,XMRG
+3 ; IA #10073
+4 FOR
DO REC^XMS3
if XMER=-1
QUIT
Begin DoDot:1
+5 IF $PIECE(XMRG,"=")="TRANSMISSION STATUS"
SET KMPVTSTAT=$PIECE(XMRG,"=",2)
+6 IF $PIECE(XMRG,"=")="COLLECTION DATE"
SET KMPVCDATE=$PIECE(XMRG,"=",2)
+7 IF $PIECE(XMRG,"=")="COLLECTION TYPE"
SET KMPVMKEY=$PIECE(XMRG,"=",2)
+8 IF $PIECE(XMRG,"=")="PARAM 1"
SET KMPPAR1=$PIECE(XMRG,"=",2)
End DoDot:1
+9 if KMPVCDATE=""
QUIT
+10 IF KMPVTSTAT="TRANSMISSION RECEIVED"
Begin DoDot:1
+11 IF KMPVMKEY="VTCM"
KILL ^KMPTMP("KMPV","VTCM","DLY",KMPVCDATE)
+12 IF KMPVMKEY="VSTM"
KILL ^KMPTMP("KMPV","VSTM","DLY",KMPVCDATE)
+13 IF KMPVMKEY="VMCM"
KILL ^KMPTMP("KMPV","VMCM","DLY",KMPVCDATE)
+14 IF KMPVMKEY="VBEM"
KILL ^KMPTMP("KMPV","VBEM","COMPRESS",KMPVCDATE)
+15 IF KMPVMKEY="VHLM"
KILL ^KMPTMP("KMPV","VHLM","DLY",KMPVCDATE,KMPPAR1)
End DoDot:1
+16 QUIT
+17 ;
GETSTAT ; Returns current status of VSM
+1 NEW KMPVFLD,KMPVFNAM,KMPVLN,KMPVMKEY,KMPVSTAT,KMPVTEXT,KMPVTFLD,KMPVTNUM
+2 DO CFGMSG^KMPVCBG("SERVER-VSMSTAT")
+3 QUIT
+4 ;
RESEND ; Resend data for one or more monitors
+1 NEW KMPVMKEY,KMPVML
+2 NEW XMER,XMRG
+3 ; IA #10073
+4 FOR
DO REC^XMS3
if XMER=-1
QUIT
Begin DoDot:1
+5 IF $PIECE(XMRG,"=")="CollectionType"
Begin DoDot:2
+6 SET KMPVMKEY=$PIECE(XMRG,"=",2)
+7 IF KMPVMKEY'=""
SET KMPVML(KMPVMKEY)=""
End DoDot:2
End DoDot:1
+8 SET KMPVMKEY=""
+9 FOR
SET KMPVMKEY=$ORDER(KMPVML(KMPVMKEY))
if KMPVMKEY=""
QUIT
Begin DoDot:1
+10 IF KMPVMKEY="VBEM"
DO EN^KMPVBETR
+11 IF KMPVMKEY="VTCM"
DO SEND^KMPVVTCM
+12 IF KMPVMKEY="VSTM"
DO SEND^KMPVVSTM
+13 IF KMPVMKEY="VMCM"
DO SEND^KMPVVMCM
+14 IF KMPVMKEY="VHLM"
DO PREPARE^KMPVVHLM
End DoDot:1
+15 QUIT
+16 ;
SETCFG() ; Change VSM configuration via national server change request
+1 NEW KMPVCALL,KMPVCFG,KMPVCFGAR,KMPVFVAL,KMPVDATA,KMPVERR,KMPVFNAM,KMPVI,KMPVLN
+2 NEW KMPVMKEY,KMPVSET,KMPVSTAT,KMPVTEXT,KMPVVAL,KMPVVALID,KMPVEARR
+3 NEW FDA,XMER,XMRG
+4 ;
+5 SET KMPVMKEY="NONE"
+6 ; Read message text and attempt to update VSM configuration
+7 ; IA #10073
+8 FOR
DO REC^XMS3
if XMER=-1
QUIT
Begin DoDot:1
+9 IF $PIECE(XMRG,"=")="MONITOR KEY"
SET KMPVMKEY=$PIECE(XMRG,"=",2)
QUIT
+10 if $PIECE(XMRG,"=")'="UPDATE KMPCFG"
QUIT
+11 SET KMPVDATA=$PIECE(XMRG,"=",2)
+12 SET KMPVFNAM=$PIECE(KMPVDATA,"^")
SET KMPVVAL=$PIECE(KMPVDATA,"^",2)
+13 SET KMPVFVAL(KMPVFNAM)=KMPVVAL
End DoDot:1
+14 ;
+15 ; verify Monitor Type is valid
+16 IF $DATA(^KMPV(8969,"B",KMPVMKEY))
SET KMPVIEN=$ORDER(^KMPV(8969,"B",KMPVMKEY,""))
+17 IF $GET(KMPVIEN)=""
Begin DoDot:1
+18 SET KMPVTEXT="Monitor "_KMPVMKEY_" not defined"
+19 SET KMPVTEXT(1)="Monitor "_KMPVMKEY_"not defined. No changes made."
+20 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+21 ;
+22 ; get field numbers and set FDA array
+23 SET KMPVFNAM=""
+24 FOR
SET KMPVFNAM=$ORDER(KMPVFVAL(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:1
+25 SET KMPVFNUM=$$FLDNUM^DILFD(8969,KMPVFNAM)
+26 IF KMPVFNUM>0
SET FDA($JOB,8969,KMPVIEN_",",KMPVFNUM)=KMPVFVAL(KMPVFNAM)
+27 IF '$TEST
SET KMPVEARR(KMPVFNAM)=""
End DoDot:1
+28 ;
+29 ; If field name does not exist send message and quit
+30 IF $DATA(KMPVEARR)
Begin DoDot:1
+31 SET KMPVTEXT=KMPVMKEY_" Configuration Update: field(s) do not exist"
+32 SET KMPVTEXT(1)="The following field(s) do not exist in the VSM CONFIGURATION file"
+33 SET KMPVFNAM=""
SET KMPVLN=2
+34 FOR
SET KMPVFNAM=$ORDER(KMPVEARR(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:2
+35 SET KMPVTEXT(KMPVLN)=KMPVFNAM
SET KMPVLN=KMPVLN+1
End DoDot:2
+36 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+37 ;
+38 ; If still good get old values for logging changes
+39 SET KMPVFNAM=""
+40 FOR
SET KMPVFNAM=$ORDER(KMPVFVAL(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:1
+41 SET $PIECE(KMPVFVAL(KMPVFNAM),"^",2)=$$GETVAL^KMPVCCFG(KMPVMKEY,KMPVFNAM,8969,"I")
End DoDot:1
+42 ;
+43 SET KMPVLN=1
+44 IF $DATA(KMPVEARR)
Begin DoDot:1
+45 SET KMPVTEXT=KMPVMKEY_" Configuration Update: FILING ERRORS - NO CHANGES MADE"
+46 SET KMPVTEXT(KMPVLN)="CONFIGURATION CHANGES NOT APPLIED!"
SET KMPVLN=KMPVLN+1
+47 SET KMPVTEXT(KMPVLN)="ERROR DETAILS: "
SET KMPVLN=KMPVLN+1
+48 SET KMPVI=""
+49 FOR
SET KMPVI=$ORDER(KMPVEARR(KMPVI))
if KMPVI=""
QUIT
Begin DoDot:2
+50 SET KMPVTEXT(KMPVLN)=KMPVEARR(KMPVI)
SET KMPVLN=KMPVLN+1
End DoDot:2
+51 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+52 ;
+53 ; ATTEMPT TO MAKE CHANGES
+54 KILL KMPVEARR
+55 DO FILE^DIE("ET","FDA($J)","KMPVEARR")
+56 ; IF ERRORS SEND MESSAGE WITH ERRORS
+57 ; Add filing errors to support message
IF $DATA(KMPVEARR)
Begin DoDot:1
+58 SET KMPVTEXT=KMPVMKEY_" Configuration Update: WITH ERRORS"
+59 SET KMPVTEXT(KMPVLN)="Changes NOT applied to VSM CONFIGURATION file"
SET KMPVLN=KMPVLN+1
+60 SET KMPVTEXT(KMPVLN)="Number of errors: "_+KMPVEARR("DIERR")
SET KMPVLN=KMPVLN+1
+61 SET KMPVENUM=""
+62 FOR
SET KMPVENUM=$ORDER(KMPVEARR("DIERR",KMPVENUM))
if +KMPVENUM=0
QUIT
Begin DoDot:2
+63 SET KMPVTNUM=""
+64 FOR
SET KMPVTNUM=$ORDER(KMPVEARR("DIERR",KMPVENUM,"TEXT",KMPVTNUM))
if +KMPVTNUM=0
QUIT
Begin DoDot:3
+65 SET KMPVTEXT(KMPVLN)=KMPVEARR("DIERR",KMPVENUM,"TEXT",KMPVTNUM)
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+66 ; If no FILING errors then list changes in Support Message and Log Changes
+67 IF '$DATA(KMPVEARR)
Begin DoDot:1
+68 SET KMPVTEXT=KMPVMKEY_" Configuration Update: No Errors"
+69 SET KMPVTEXT(KMPVLN)="Changes applied to VSM CONFIGURATION file"
SET KMPVLN=KMPVLN+1
+70 SET KMPVTEXT(KMPVLN)="CHANGED FIELDS:"
SET KMPVLN=KMPVLN+1
+71 ; list changes in Support Message
+72 SET KMPVFNAM=""
+73 FOR
SET KMPVFNAM=$ORDER(KMPVFVAL(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:2
+74 SET KMPVDATA=KMPVFVAL(KMPVFNAM)
+75 SET KMPVTEXT(KMPVLN)=KMPVFNAM_" : "_$PIECE(KMPVDATA,"^",2)_" --> "_$PIECE(KMPVDATA,"^")
SET KMPVLN=KMPVLN+1
End DoDot:2
End DoDot:1
+76 ;
+77 ; if end state is 'ON' then re-schedule -- if 'OFF' then de-schedule
+78 SET KMPVON=$$GETVAL^KMPVCCFG(KMPVMKEY,"ONOFF",8969)
+79 IF KMPVON="ON"
DO STARTMON^KMPVCBG(KMPVMKEY,1)
+80 IF KMPVON="OFF"
DO STOPMON^KMPVCBG(KMPVMKEY,1)
+81 ;
+82 ; Mail config back to National Server
+83 DO CFGMSG^KMPVCBG("SERVER-VSMCFG")
+84 ; Mail results back to SUPPORT mail groups
+85 DO SUPMSG^KMPVCBG(.KMPVTEXT)
+86 ;
+87 QUIT
+88 ;
KMPUPDEF ; Update VSM MONITOR DEFAULTS file. Optionally apply defaults to VSM CONFIGURATION file.
+1 NEW KMPVADEF,KMPVDATA,KMPVEARR,KMPVENUM,KMPVFNAM,KMPVFVAL,KMPVI,KMPVIEN,KMPVIEN,KMPVLN,KMPVMKEY
+2 NEW KMPVON,KMPVREST,KMPVTEXT,KMPVTNUM,KMPVVAL
+3 NEW FDA,XMER,XMRG
+4 ;
+5 SET KMPVMKEY="NONE"
+6 ; Read message text to get data to change
+7 ; IA #10073
+8 FOR
DO REC^XMS3
if XMER=-1
QUIT
Begin DoDot:1
+9 IF $PIECE(XMRG,"=")="MONITOR KEY"
SET KMPVMKEY=$PIECE(XMRG,"=",2)
QUIT
+10 IF $PIECE(XMRG,"=")="APPLY DEFAULTS"
SET KMPVADEF=$PIECE(XMRG,"=",2)
QUIT
+11 if $PIECE(XMRG,"=")'="UPDATE KMPDEF"
QUIT
+12 SET KMPVDATA=$PIECE(XMRG,"=",2)
+13 SET KMPVFNAM=$PIECE(KMPVDATA,"^")
SET KMPVVAL=$PIECE(KMPVDATA,"^",2)
+14 SET KMPVFVAL(KMPVFNAM)=KMPVVAL
End DoDot:1
+15 ;
+16 ; verify Monitor Type is valid
+17 IF $DATA(^KMPV(8969.02,"B",KMPVMKEY))
SET KMPVIEN=$ORDER(^KMPV(8969.02,"B",KMPVMKEY,""))
+18 IF $GET(KMPVIEN)=""
Begin DoDot:1
+19 SET KMPVTEXT="Monitor "_KMPVMKEY_" not defined"
+20 SET KMPVTEXT(1)="Monitor "_KMPVMKEY_"not defined. No changes made."
+21 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+22 ;
+23 ; get field numbers and set FDA array
+24 SET KMPVFNAM=""
+25 FOR
SET KMPVFNAM=$ORDER(KMPVFVAL(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:1
+26 SET KMPVFNUM=$$FLDNUM^DILFD(8969.02,KMPVFNAM)
+27 IF KMPVFNUM>0
SET FDA($JOB,8969.02,KMPVIEN_",",KMPVFNUM)=KMPVFVAL(KMPVFNAM)
+28 IF '$TEST
SET KMPVEARR(KMPVFNAM)=""
End DoDot:1
+29 ; If field name does not exist send message and quit
+30 IF $DATA(KMPVEARR)
Begin DoDot:1
+31 SET KMPVTEXT=KMPVMKEY_" Default Value Update: field(s) do not exist"
+32 SET KMPVTEXT(1)="The following field(s) do not exist in the VSM MONITOR DEFAULTS file"
+33 SET KMPVFNAM=""
SET KMPVLN=2
+34 FOR
SET KMPVFNAM=$ORDER(KMPVEARR(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:2
+35 SET KMPVTEXT(KMPVLN)=KMPVFNAM
SET KMPVLN=KMPVLN+1
End DoDot:2
+36 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+37 ;
+38 ; If still good get old values for logging changes
+39 SET KMPVFNAM=""
+40 FOR
SET KMPVFNAM=$ORDER(KMPVFVAL(KMPVFNAM))
if KMPVFNAM=""
QUIT
Begin DoDot:1
+41 SET $PIECE(KMPVFVAL(KMPVFNAM),"^",2)=$$GETVAL^KMPVCCFG(KMPVMKEY,KMPVFNAM,8969.02,"I")
End DoDot:1
+42 ;
+43 ; Update VSM MONITOR DEFAULTS file
+44 DO FILE^DIE("ET","FDA($J)","KMPVEARR")
+45 ;
+46 ; If filing errors send message and quit
+47 IF $DATA(KMPVEARR)
Begin DoDot:1
+48 SET KMPVTEXT=KMPVMKEY_" Default Value Update: Filing Errors"
SET KMPVLN=1
+49 SET KMPVI=0
+50 FOR
SET KMPVI=$ORDER(KMPVEARR("DIERR",KMPVI))
if KMPVI=""
QUIT
Begin DoDot:2
+51 SET KMPVTNUM=""
+52 FOR
SET KMPVTNUM=$ORDER(KMPVEARR("DIERR",KMPVI,"TEXT",KMPVTNUM))
if KMPVTNUM=""
QUIT
Begin DoDot:3
+53 SET KMPVTEXT(KMPVLN)=KMPVEARR("DIERR",KMPVI,"TEXT",KMPVTNUM)
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
+54 DO SUPMSG^KMPVCBG(.KMPVTEXT)
End DoDot:1
QUIT
+55 ;
+56 ; If not applying defaults send SUPMSG and quit
+57 IF +$GET(KMPVADEF)=0
Begin DoDot:1
+58 SET KMPVTEXT=KMPVMKEY_" Default Value Update: Successful"
+59 SET KMPVTEXT(1)="Changes made to VSM MONITOR DEFAULTS file"
+60 SET KMPVTEXT(2)="Changes not applied to VSM CONFIGURATION file"
+61 DO CFGMSG^KMPVCBG("SERVER-VSMUPDEF")
+62 DO SUPMSG^KMPVCBG(.KMPVTEXT)
+63 End DoDot:1
QUIT
+64 ;
+65 ; if applying defaults set defaults into VSM CONFIGURATION file
+66 SET KMPVLN=1
+67 SET KMPVTEXT(KMPVLN)="Changes successfully made to VSM MONITOR DEFAULTS file"
SET KMPVLN=KMPVLN+1
+68 SET KMPVSTAT=$$RESTCFG^KMPVCCFG(KMPVMKEY)
+69 IF KMPVSTAT=0
Begin DoDot:1
+70 SET KMPVTEXT=KMPVMKEY_" Default Value Update: No Errors"
+71 SET KMPVTEXT(KMPVLN)="Changes applied to VSM CONFIGURATION file"
SET KMPVLN=KMPVLN+1
End DoDot:1
+72 IF KMPVSTAT>0
Begin DoDot:1
+73 SET KMPVTEXT=KMPVMKEY_" Default Value Update: WITH ERRORS"
+74 SET KMPVTEXT(KMPVLN)="Changes NOT applied to VSM CONFIGURATION file"
SET KMPVLN=KMPVLN+1
End DoDot:1
+75 ;
+76 ; if end state is 'ON' then reschedule
+77 SET KMPVON=$$GETVAL^KMPVCCFG(KMPVMKEY,"ONOFF",8969)
+78 IF KMPVON="ON"
Begin DoDot:1
+79 DO RESCH^KMPVCBG(KMPVMKEY,.KMPVERR)
+80 IF '$DATA(KMPVERR)
SET KMPVTEXT(KMPVLN)="Data Transmission task successfully rescheduled"
SET KMPVLN=KMPVLN+1
+81 IF $DATA(KMPVERR)>0
Begin DoDot:2
+82 SET KMPVTEXT=KMPVMKEY_" Default Value Update: WITH ERRORS"
+83 SET KMPVTEXT(KMPVLN)="Data Transmission NOT successfully rescheduled"
SET KMPVLN=KMPVLN+1
+84 SET KMPVI=""
+85 FOR
SET KMPVI=$ORDER(KMPVERR(KMPVI))
if KMPVI=""
QUIT
Begin DoDot:3
+86 SET KMPVTEXT(KMPVLN)=KMPVERR(KMPVI)
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+87 IF KMPVON="OFF"
Begin DoDot:1
+88 DO DESCH^KMPVCBG(KMPVMKEY,.KMPVERR)
+89 SET KMPVTEXT(KMPVLN)="Data Transmission task successfully unscheduled"
SET KMPVLN=KMPVLN+1
+90 IF $DATA(KMPVERR)>0
Begin DoDot:2
+91 SET KMPVTEXT=KMPVMKEY_" Configuration Update: WITH ERRORS"
+92 SET KMPVTEXT(KMPVLN-1)="Data Transmission NOT successfully unscheduled"
SET KMPVLN=KMPVLN+1
+93 SET KMPVI=""
+94 FOR
SET KMPVI=$ORDER(KMPVERR(KMPVI))
if KMPVI=""
QUIT
Begin DoDot:3
+95 SET KMPVTEXT(KMPVLN)=KMPVERR(KMPVI)
SET KMPVLN=KMPVLN+1
End DoDot:3
End DoDot:2
End DoDot:1
+96 ;
+97 DO SUPMSG^KMPVCBG(.KMPVTEXT)
+98 QUIT
+99 ;
CTMLOG ; Return run history recorded in the VSM CACHE TASK LOG file
+1 NEW KMPVMKEY,KMPVML,KMPVTEXT
+2 NEW XMER
+3 ;
+4 SET KMPVIEN=0
SET KMPVLN=1
+5 SET KMPVTEXT(KMPVLN)="Raw data from VSM CACHE TASK LOG file"
SET KMPVLN=KMPVLN+1
+6 FOR
SET KMPVIEN=$ORDER(^KMPV(8969.03,KMPVIEN))
if +KMPVIEN=0
QUIT
Begin DoDot:1
+7 SET KMPVDATA=$GET(^KMPV(8969.03,KMPVIEN,0))
+8 SET KMPVTEXT(KMPVLN)=KMPVDATA
SET KMPVLN=KMPVLN+1
End DoDot:1
+9 SET KMPVTEXT="Task Manager Run History for "_KMPVSITE
+10 DO DBAMSG^KMPVCBG(.KMPVTEXT)
+11 QUIT
+12 ;
PACKUPDT ; Get data from PACKAGE file
+1 NEW KMPVCNAM,KMPVCNS,KMPVDOM,KMPVEMAIL,KMPVIEN,KMPVIEN2,KMPVLN,KMPVPDATA,KMPVPNAM,KMPVPNS,KMPVPRE,KMPVPROD,KMPVSCD,KMPVSINF
+2 NEW X,XMSUB,XMTEXT,XMY,XMZ,Y
+3 SET KMPVPROD=$$PROD^KMPVCCFG()
+4 ;IA 2734
SET KMPVDOM=$PIECE($$NETNAME^XMXUTIL(.5),"@",2)
+5 ; IA 10112
SET KMPVSITE=$$SITE^VASITE
+6 ; IA 10097
DO GETENV^%ZOSV
SET KMPVSCD=$PIECE(Y,U,1)
+7 SET KMPVSINF=$$SITEINFO^KMPVCCFG()
+8 SET XMSUB="VBEMPACK"
+9 SET KMPVPRE=""
SET KMPVLN=1
+10 SET KMPVTEXT(KMPVLN)="SYSTEM ID="_KMPVSINF
SET KMPVLN=KMPVLN+1
+11 FOR
SET KMPVPRE=$ORDER(^DIC(9.4,"C",KMPVPRE))
if KMPVPRE=""
QUIT
Begin DoDot:1
+12 SET KMPVIEN=""
+13 ; NO WAY TO DECIDE WHICH IS CORRECT SO TAKE FIRST - DON'T LOOP
+14 SET KMPVIEN=$ORDER(^DIC(9.4,"C",KMPVPRE,KMPVIEN))
if KMPVIEN=""
QUIT
Begin DoDot:2
+15 ;,KMPVCNAM=KMPVPNAM
SET KMPVPNAM=$PIECE($GET(^DIC(9.4,KMPVIEN,0)),"^")
+16 SET KMPVTEXT(KMPVLN)="PACKINFO="_KMPVPRE_"^"_KMPVPNAM
SET KMPVLN=KMPVLN+1
End DoDot:2
End DoDot:1
+17 SET XMTEXT=$SELECT($DATA(KMPVTEXT):"KMPVTEXT(",1:"No package data collected")
+18 SET KMPVEMAIL=$$GETVAL^KMPVCCFG("VBEM","VSM CFG EMAIL ADDRESS",8969)
IF KMPVEMAIL'=""
SET XMY(KMPVEMAIL)=""
+19 DO ^XMD
+20 QUIT
