Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPVCSRV

KMPVCSRV.m

Go to the documentation of this file.
  1. KMPVCSRV ;SP/JML - VSM Server routine for VistA functions ;5/1/2017
  1. ;;4.0;CAPACITY MANAGEMENT;;3/1/2018;Build 38;
  1. ;
  1. ;
  1. EN ; Server routine entry point
  1. ;
  1. Q:'$G(XQMSG)
  1. N XMZ,XMRG,XMER
  1. S XMZ=XQMSG
  1. S XQSUB=$G(XQSUB)
  1. N KMPVCHKF,KMPVFNUM,KMPVFUNC,KMPVRQNAM,KMPVSITE,KMPVSNAME,KMPVTEXT
  1. ;
  1. S KMPVFUNC=$P(XQSUB,"^"),KMPVSNAME=$P(XQSUB,"^",2),KMPVFNUM=$P(XQSUB,"^",3),KMPVRQNAM=$P(XQSUB,"^",4)
  1. S KMPVSITE=$$SITE^VASITE ; IA 10112
  1. I KMPVSNAME'=$P(KMPVSITE,"^",2)!(KMPVFNUM'=$P(KMPVSITE,"^",3)) D Q
  1. .S KMPVTEXT="WARN^CLIENT REQUEST LOCATION MISMATCH^"
  1. .S KMPVTEXT(1)="SITE DATA IN EMAIL: "_KMPVSNAME_"^"_KMPVFNUM
  1. .S KMPVTEXT(2)="SITE DATA AT SITE: "_KMPVSITE
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ; verify request is for valid function
  1. S KMPVCHKF="^"_KMPVFUNC_"^"
  1. I "^ACK^GETSTAT^RESEND^SETCFG^KMPUPDEF^CTMLOG^PACKUPDT^"'[KMPVCHKF D Q
  1. .S KMPVTEXT="WARN^CLIENT REQUEST INVALID FUNCTION^"
  1. .S KMPVTEXT(1)="FUNCTION REQUEST="_KMPVFUNC
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. D @KMPVFUNC
  1. Q
  1. ; -- Tasks Via Email Requests --
  1. ;
  1. ACK ; Receive acknowledge VSM receipt of VTCM data - delete from local node
  1. N KMPVCDATE,KMPVTSTAT,KMPVMT,KMPPAR1
  1. N XMER,XMRG
  1. ; IA #10073
  1. F D REC^XMS3 Q:XMER=-1 D
  1. .I $P(XMRG,"=")="TRANSMISSION STATUS" S KMPVTSTAT=$P(XMRG,"=",2)
  1. .I $P(XMRG,"=")="COLLECTION DATE" S KMPVCDATE=$P(XMRG,"=",2)
  1. .I $P(XMRG,"=")="COLLECTION TYPE" S KMPVMKEY=$P(XMRG,"=",2)
  1. .I $P(XMRG,"=")="PARAM 1" S KMPPAR1=$P(XMRG,"=",2)
  1. Q:KMPVCDATE=""
  1. I KMPVTSTAT="TRANSMISSION RECEIVED" D
  1. .I KMPVMKEY="VTCM" K ^KMPTMP("KMPV","VTCM","DLY",KMPVCDATE)
  1. .I KMPVMKEY="VSTM" K ^KMPTMP("KMPV","VSTM","DLY",KMPVCDATE)
  1. .I KMPVMKEY="VMCM" K ^KMPTMP("KMPV","VMCM","DLY",KMPVCDATE)
  1. .I KMPVMKEY="VBEM" K ^KMPTMP("KMPV","VBEM","COMPRESS",KMPVCDATE)
  1. .I KMPVMKEY="VHLM" K ^KMPTMP("KMPV","VHLM","DLY",KMPVCDATE,KMPPAR1)
  1. Q
  1. ;
  1. GETSTAT ; Returns current status of VSM
  1. N KMPVFLD,KMPVFNAM,KMPVLN,KMPVMKEY,KMPVSTAT,KMPVTEXT,KMPVTFLD,KMPVTNUM
  1. D CFGMSG^KMPVCBG("SERVER-VSMSTAT")
  1. Q
  1. ;
  1. RESEND ; Resend data for one or more monitors
  1. N KMPVMKEY,KMPVML
  1. N XMER,XMRG
  1. ; IA #10073
  1. F D REC^XMS3 Q:XMER=-1 D
  1. .I $P(XMRG,"=")="CollectionType" D
  1. ..S KMPVMKEY=$P(XMRG,"=",2)
  1. ..I KMPVMKEY'="" S KMPVML(KMPVMKEY)=""
  1. S KMPVMKEY=""
  1. F S KMPVMKEY=$O(KMPVML(KMPVMKEY)) Q:KMPVMKEY="" D
  1. .I KMPVMKEY="VBEM" D EN^KMPVBETR
  1. .I KMPVMKEY="VTCM" D SEND^KMPVVTCM
  1. .I KMPVMKEY="VSTM" D SEND^KMPVVSTM
  1. .I KMPVMKEY="VMCM" D SEND^KMPVVMCM
  1. .I KMPVMKEY="VHLM" D PREPARE^KMPVVHLM
  1. Q
  1. ;
  1. SETCFG() ; Change VSM configuration via national server change request
  1. N KMPVCALL,KMPVCFG,KMPVCFGAR,KMPVFVAL,KMPVDATA,KMPVERR,KMPVFNAM,KMPVI,KMPVLN
  1. N KMPVMKEY,KMPVSET,KMPVSTAT,KMPVTEXT,KMPVVAL,KMPVVALID,KMPVEARR
  1. N FDA,XMER,XMRG
  1. ;
  1. S KMPVMKEY="NONE"
  1. ; Read message text and attempt to update VSM configuration
  1. ; IA #10073
  1. F D REC^XMS3 Q:XMER=-1 D
  1. .I $P(XMRG,"=")="MONITOR KEY" S KMPVMKEY=$P(XMRG,"=",2) Q
  1. .Q:$P(XMRG,"=")'="UPDATE KMPCFG"
  1. .S KMPVDATA=$P(XMRG,"=",2)
  1. .S KMPVFNAM=$P(KMPVDATA,"^"),KMPVVAL=$P(KMPVDATA,"^",2)
  1. .S KMPVFVAL(KMPVFNAM)=KMPVVAL
  1. ;
  1. ; verify Monitor Type is valid
  1. I $D(^KMPV(8969,"B",KMPVMKEY)) S KMPVIEN=$O(^KMPV(8969,"B",KMPVMKEY,""))
  1. I $G(KMPVIEN)="" D Q
  1. .S KMPVTEXT="Monitor "_KMPVMKEY_" not defined"
  1. .S KMPVTEXT(1)="Monitor "_KMPVMKEY_"not defined. No changes made."
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. ; get field numbers and set FDA array
  1. S KMPVFNAM=""
  1. F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
  1. .S KMPVFNUM=$$FLDNUM^DILFD(8969,KMPVFNAM)
  1. .I KMPVFNUM>0 S FDA($J,8969,KMPVIEN_",",KMPVFNUM)=KMPVFVAL(KMPVFNAM)
  1. .E S KMPVEARR(KMPVFNAM)=""
  1. ;
  1. ; If field name does not exist send message and quit
  1. I $D(KMPVEARR) D Q
  1. .S KMPVTEXT=KMPVMKEY_" Configuration Update: field(s) do not exist"
  1. .S KMPVTEXT(1)="The following field(s) do not exist in the VSM CONFIGURATION file"
  1. .S KMPVFNAM="",KMPVLN=2
  1. .F S KMPVFNAM=$O(KMPVEARR(KMPVFNAM)) Q:KMPVFNAM="" D
  1. ..S KMPVTEXT(KMPVLN)=KMPVFNAM,KMPVLN=KMPVLN+1
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. ; If still good get old values for logging changes
  1. S KMPVFNAM=""
  1. F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
  1. .S $P(KMPVFVAL(KMPVFNAM),"^",2)=$$GETVAL^KMPVCCFG(KMPVMKEY,KMPVFNAM,8969,"I")
  1. ;
  1. S KMPVLN=1
  1. I $D(KMPVEARR) D Q
  1. .S KMPVTEXT=KMPVMKEY_" Configuration Update: FILING ERRORS - NO CHANGES MADE"
  1. .S KMPVTEXT(KMPVLN)="CONFIGURATION CHANGES NOT APPLIED!",KMPVLN=KMPVLN+1
  1. .S KMPVTEXT(KMPVLN)="ERROR DETAILS: ",KMPVLN=KMPVLN+1
  1. .S KMPVI=""
  1. .F S KMPVI=$O(KMPVEARR(KMPVI)) Q:KMPVI="" D
  1. ..S KMPVTEXT(KMPVLN)=KMPVEARR(KMPVI),KMPVLN=KMPVLN+1
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. ; ATTEMPT TO MAKE CHANGES
  1. K KMPVEARR
  1. D FILE^DIE("ET","FDA($J)","KMPVEARR")
  1. ; IF ERRORS SEND MESSAGE WITH ERRORS
  1. I $D(KMPVEARR) D ; Add filing errors to support message
  1. .S KMPVTEXT=KMPVMKEY_" Configuration Update: WITH ERRORS"
  1. .S KMPVTEXT(KMPVLN)="Changes NOT applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
  1. .S KMPVTEXT(KMPVLN)="Number of errors: "_+KMPVEARR("DIERR"),KMPVLN=KMPVLN+1
  1. .S KMPVENUM=""
  1. .F S KMPVENUM=$O(KMPVEARR("DIERR",KMPVENUM)) Q:+KMPVENUM=0 D
  1. ..S KMPVTNUM=""
  1. ..F S KMPVTNUM=$O(KMPVEARR("DIERR",KMPVENUM,"TEXT",KMPVTNUM)) Q:+KMPVTNUM=0 D
  1. ...S KMPVTEXT(KMPVLN)=KMPVEARR("DIERR",KMPVENUM,"TEXT",KMPVTNUM),KMPVLN=KMPVLN+1
  1. ; If no FILING errors then list changes in Support Message and Log Changes
  1. I '$D(KMPVEARR) D
  1. .S KMPVTEXT=KMPVMKEY_" Configuration Update: No Errors"
  1. .S KMPVTEXT(KMPVLN)="Changes applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
  1. .S KMPVTEXT(KMPVLN)="CHANGED FIELDS:",KMPVLN=KMPVLN+1
  1. .; list changes in Support Message
  1. .S KMPVFNAM=""
  1. .F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
  1. ..S KMPVDATA=KMPVFVAL(KMPVFNAM)
  1. ..S KMPVTEXT(KMPVLN)=KMPVFNAM_" : "_$P(KMPVDATA,"^",2)_" --> "_$P(KMPVDATA,"^"),KMPVLN=KMPVLN+1
  1. ;
  1. ; if end state is 'ON' then re-schedule -- if 'OFF' then de-schedule
  1. S KMPVON=$$GETVAL^KMPVCCFG(KMPVMKEY,"ONOFF",8969)
  1. I KMPVON="ON" D STARTMON^KMPVCBG(KMPVMKEY,1)
  1. I KMPVON="OFF" D STOPMON^KMPVCBG(KMPVMKEY,1)
  1. ;
  1. ; Mail config back to National Server
  1. D CFGMSG^KMPVCBG("SERVER-VSMCFG")
  1. ; Mail results back to SUPPORT mail groups
  1. D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. Q
  1. ;
  1. KMPUPDEF ; Update VSM MONITOR DEFAULTS file. Optionally apply defaults to VSM CONFIGURATION file.
  1. N KMPVADEF,KMPVDATA,KMPVEARR,KMPVENUM,KMPVFNAM,KMPVFVAL,KMPVI,KMPVIEN,KMPVIEN,KMPVLN,KMPVMKEY
  1. N KMPVON,KMPVREST,KMPVTEXT,KMPVTNUM,KMPVVAL
  1. N FDA,XMER,XMRG
  1. ;
  1. S KMPVMKEY="NONE"
  1. ; Read message text to get data to change
  1. ; IA #10073
  1. F D REC^XMS3 Q:XMER=-1 D
  1. .I $P(XMRG,"=")="MONITOR KEY" S KMPVMKEY=$P(XMRG,"=",2) Q
  1. .I $P(XMRG,"=")="APPLY DEFAULTS" S KMPVADEF=$P(XMRG,"=",2) Q
  1. .Q:$P(XMRG,"=")'="UPDATE KMPDEF"
  1. .S KMPVDATA=$P(XMRG,"=",2)
  1. .S KMPVFNAM=$P(KMPVDATA,"^"),KMPVVAL=$P(KMPVDATA,"^",2)
  1. .S KMPVFVAL(KMPVFNAM)=KMPVVAL
  1. ;
  1. ; verify Monitor Type is valid
  1. I $D(^KMPV(8969.02,"B",KMPVMKEY)) S KMPVIEN=$O(^KMPV(8969.02,"B",KMPVMKEY,""))
  1. I $G(KMPVIEN)="" D Q
  1. .S KMPVTEXT="Monitor "_KMPVMKEY_" not defined"
  1. .S KMPVTEXT(1)="Monitor "_KMPVMKEY_"not defined. No changes made."
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. ; get field numbers and set FDA array
  1. S KMPVFNAM=""
  1. F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
  1. .S KMPVFNUM=$$FLDNUM^DILFD(8969.02,KMPVFNAM)
  1. .I KMPVFNUM>0 S FDA($J,8969.02,KMPVIEN_",",KMPVFNUM)=KMPVFVAL(KMPVFNAM)
  1. .E S KMPVEARR(KMPVFNAM)=""
  1. ; If field name does not exist send message and quit
  1. I $D(KMPVEARR) D Q
  1. .S KMPVTEXT=KMPVMKEY_" Default Value Update: field(s) do not exist"
  1. .S KMPVTEXT(1)="The following field(s) do not exist in the VSM MONITOR DEFAULTS file"
  1. .S KMPVFNAM="",KMPVLN=2
  1. .F S KMPVFNAM=$O(KMPVEARR(KMPVFNAM)) Q:KMPVFNAM="" D
  1. ..S KMPVTEXT(KMPVLN)=KMPVFNAM,KMPVLN=KMPVLN+1
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. ; If still good get old values for logging changes
  1. S KMPVFNAM=""
  1. F S KMPVFNAM=$O(KMPVFVAL(KMPVFNAM)) Q:KMPVFNAM="" D
  1. .S $P(KMPVFVAL(KMPVFNAM),"^",2)=$$GETVAL^KMPVCCFG(KMPVMKEY,KMPVFNAM,8969.02,"I")
  1. ;
  1. ; Update VSM MONITOR DEFAULTS file
  1. D FILE^DIE("ET","FDA($J)","KMPVEARR")
  1. ;
  1. ; If filing errors send message and quit
  1. I $D(KMPVEARR) D Q
  1. .S KMPVTEXT=KMPVMKEY_" Default Value Update: Filing Errors",KMPVLN=1
  1. .S KMPVI=0
  1. .F S KMPVI=$O(KMPVEARR("DIERR",KMPVI)) Q:KMPVI="" D
  1. ..S KMPVTNUM=""
  1. ..F S KMPVTNUM=$O(KMPVEARR("DIERR",KMPVI,"TEXT",KMPVTNUM)) Q:KMPVTNUM="" D
  1. ...S KMPVTEXT(KMPVLN)=KMPVEARR("DIERR",KMPVI,"TEXT",KMPVTNUM),KMPVLN=KMPVLN+1
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. ;
  1. ; If not applying defaults send SUPMSG and quit
  1. I +$G(KMPVADEF)=0 D Q
  1. .S KMPVTEXT=KMPVMKEY_" Default Value Update: Successful"
  1. .S KMPVTEXT(1)="Changes made to VSM MONITOR DEFAULTS file"
  1. .S KMPVTEXT(2)="Changes not applied to VSM CONFIGURATION file"
  1. .D CFGMSG^KMPVCBG("SERVER-VSMUPDEF")
  1. .D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. .
  1. ;
  1. ; if applying defaults set defaults into VSM CONFIGURATION file
  1. S KMPVLN=1
  1. S KMPVTEXT(KMPVLN)="Changes successfully made to VSM MONITOR DEFAULTS file",KMPVLN=KMPVLN+1
  1. S KMPVSTAT=$$RESTCFG^KMPVCCFG(KMPVMKEY)
  1. I KMPVSTAT=0 D
  1. .S KMPVTEXT=KMPVMKEY_" Default Value Update: No Errors"
  1. .S KMPVTEXT(KMPVLN)="Changes applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
  1. I KMPVSTAT>0 D
  1. .S KMPVTEXT=KMPVMKEY_" Default Value Update: WITH ERRORS"
  1. .S KMPVTEXT(KMPVLN)="Changes NOT applied to VSM CONFIGURATION file",KMPVLN=KMPVLN+1
  1. ;
  1. ; if end state is 'ON' then reschedule
  1. S KMPVON=$$GETVAL^KMPVCCFG(KMPVMKEY,"ONOFF",8969)
  1. I KMPVON="ON" D
  1. .D RESCH^KMPVCBG(KMPVMKEY,.KMPVERR)
  1. .I '$D(KMPVERR) S KMPVTEXT(KMPVLN)="Data Transmission task successfully rescheduled",KMPVLN=KMPVLN+1
  1. .I $D(KMPVERR)>0 D
  1. ..S KMPVTEXT=KMPVMKEY_" Default Value Update: WITH ERRORS"
  1. ..S KMPVTEXT(KMPVLN)="Data Transmission NOT successfully rescheduled",KMPVLN=KMPVLN+1
  1. ..S KMPVI=""
  1. ..F S KMPVI=$O(KMPVERR(KMPVI)) Q:KMPVI="" D
  1. ...S KMPVTEXT(KMPVLN)=KMPVERR(KMPVI),KMPVLN=KMPVLN+1
  1. I KMPVON="OFF" D
  1. .D DESCH^KMPVCBG(KMPVMKEY,.KMPVERR)
  1. .S KMPVTEXT(KMPVLN)="Data Transmission task successfully unscheduled",KMPVLN=KMPVLN+1
  1. .I $D(KMPVERR)>0 D
  1. ..S KMPVTEXT=KMPVMKEY_" Configuration Update: WITH ERRORS"
  1. ..S KMPVTEXT(KMPVLN-1)="Data Transmission NOT successfully unscheduled",KMPVLN=KMPVLN+1
  1. ..S KMPVI=""
  1. ..F S KMPVI=$O(KMPVERR(KMPVI)) Q:KMPVI="" D
  1. ...S KMPVTEXT(KMPVLN)=KMPVERR(KMPVI),KMPVLN=KMPVLN+1
  1. ;
  1. D SUPMSG^KMPVCBG(.KMPVTEXT)
  1. Q
  1. ;
  1. CTMLOG ; Return run history recorded in the VSM CACHE TASK LOG file
  1. N KMPVMKEY,KMPVML,KMPVTEXT
  1. N XMER
  1. ;
  1. S KMPVIEN=0,KMPVLN=1
  1. S KMPVTEXT(KMPVLN)="Raw data from VSM CACHE TASK LOG file",KMPVLN=KMPVLN+1
  1. F S KMPVIEN=$O(^KMPV(8969.03,KMPVIEN)) Q:+KMPVIEN=0 D
  1. .S KMPVDATA=$G(^KMPV(8969.03,KMPVIEN,0))
  1. .S KMPVTEXT(KMPVLN)=KMPVDATA,KMPVLN=KMPVLN+1
  1. S KMPVTEXT="Task Manager Run History for "_KMPVSITE
  1. D DBAMSG^KMPVCBG(.KMPVTEXT)
  1. Q
  1. ;
  1. PACKUPDT ; Get data from PACKAGE file
  1. N KMPVCNAM,KMPVCNS,KMPVDOM,KMPVEMAIL,KMPVIEN,KMPVIEN2,KMPVLN,KMPVPDATA,KMPVPNAM,KMPVPNS,KMPVPRE,KMPVPROD,KMPVSCD,KMPVSINF
  1. N X,XMSUB,XMTEXT,XMY,XMZ,Y
  1. S KMPVPROD=$$PROD^KMPVCCFG()
  1. S KMPVDOM=$P($$NETNAME^XMXUTIL(.5),"@",2) ;IA 2734
  1. S KMPVSITE=$$SITE^VASITE ; IA 10112
  1. D GETENV^%ZOSV S KMPVSCD=$P(Y,U,1) ; IA 10097
  1. S KMPVSINF=$$SITEINFO^KMPVCCFG()
  1. S XMSUB="VBEMPACK"
  1. S KMPVPRE="",KMPVLN=1
  1. S KMPVTEXT(KMPVLN)="SYSTEM ID="_KMPVSINF,KMPVLN=KMPVLN+1
  1. F S KMPVPRE=$O(^DIC(9.4,"C",KMPVPRE)) Q:KMPVPRE="" D
  1. .S KMPVIEN=""
  1. .; NO WAY TO DECIDE WHICH IS CORRECT SO TAKE FIRST - DON'T LOOP
  1. .S KMPVIEN=$O(^DIC(9.4,"C",KMPVPRE,KMPVIEN)) Q:KMPVIEN="" D
  1. ..S KMPVPNAM=$P($G(^DIC(9.4,KMPVIEN,0)),"^") ;,KMPVCNAM=KMPVPNAM
  1. ..S KMPVTEXT(KMPVLN)="PACKINFO="_KMPVPRE_"^"_KMPVPNAM,KMPVLN=KMPVLN+1
  1. S XMTEXT=$S($D(KMPVTEXT):"KMPVTEXT(",1:"No package data collected")
  1. S KMPVEMAIL=$$GETVAL^KMPVCCFG("VBEM","VSM CFG EMAIL ADDRESS",8969) I KMPVEMAIL'="" S XMY(KMPVEMAIL)=""
  1. D ^XMD
  1. Q