- 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 Feb 18, 2025@23:08:24 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