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

DGAUDIT3.m

Go to the documentation of this file. 
  1. DGAUDIT3 ;ATG/JPN,ISL/DKA - VAS Audit Solution - Request System Parameters  ;May 17, 2021@15:12
  1.  ;;5.3;Registration;**964,1108,1120**;Aug 13, 1993;Build 6
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; Reference to GETS^DIQ in ICR #2056
  1.  ; Reference to $$GET1^DIQ in ICR #2056
  1.  ; Reference to $$GET^XPAR in ICR #2263
  1.  ; Reference to EN^XPAR in ICR #2263
  1.  ; Reference to EN^DIQ in ICR #10004
  1.  ; Reference to ^DIC in ICR #10006
  1.  ; Reference to ^DIE in ICR #10018
  1.  ; Reference to ^DIR in ICR #10026
  1.  ; Reference to ^XMB(3.8 in ICR #10111
  1.  ; Reference to GOTLOCAL^XMXAPIG in ICR #3006
  1.  ; Reference to $$MG^XMBGRP in ICR #1146
  1.  ; Reference to ^XUSEC(KEY,DUZ) in ICR #10076
  1.  ; Reference to EDITPAR^XPAREDIT in ICR #2336
  1.  ;
  1.  Q  ; No entry from top
  1.  ;
  1. EN ; Main entry point
  1.  N DA,DIC,DIE,DGFLD,DGVPARR,DGVPNAME,DGVSTAT,DGVSTATI,DR,Y,DGSNDON,DGCSTAT,AUDGREF,CNTREC,DGDATE,DGREC,FILENUM,GREF,I,DGBADSRVR,DGMGROK,DGAUDDATA
  1.  I '$D(^XUSEC("DG SECURITY OFFICER",+$G(DUZ))) W !,*7,"You do not have the appropriate access privileges to modify the AUDIT settings." Q
  1.  ; Display the current values of our DG VAS CONFIG fields   ; FLS Changed VSRA TO VAS 3/16/2021
  1.  S DGCSTAT=$$GET1^DIQ(46.5,1,.02,"I") ; Get status flag and save value
  1.  D DISPLAY
  1.  S DGSNDON=$$GET1^DIQ(46.4,1,.04,"I") ; FLS Checking DATE VAS STARTED. If it's empty then it will be set if STATUS is on.
  1.  ;
  1.  S DGMGROK=$$MGRPOK()
  1.  I 'DGMGROK D
  1.  . N DIR,Y K DIR
  1.  . S DIR("A",1)="WARNING! The DG VAS MONITOR GROUP mail group parameter"
  1.  . S DIR("A",2)="does not contain a mail group with active members. "
  1.  . W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  I DGMGROK!$$GET1^DIQ(46.5,1,.02) S DGFLD=.02,DIE="46.5",DR=DGFLD,DA=1 D ^DIE
  1.  I ($$GET1^DIQ(46.5,1,.02,"I")=1) D
  1.  . N DGSRVR,DGDNS
  1.  . S DGSRVR=+$$FIND1^DIC(18.12,"","X","DG VAS WEB SERVER")
  1.  . I DGSRVR S DGDNS=$$GET1^DIQ(18.12,DGSRVR,.04)
  1.  . I (DGDNS="")!(DGDNS'["domain.ext") D
  1.  .. N DIR,Y,DGERR
  1.  .. S DIR(0)="Y",DIR("B")="Y",DIR("A",1)="",DIR("A",2)="WARNING! The SERVER value of DG VAS WEB SERVER appears to be invalid."
  1.  .. S DIR("A",3)="      ** No records will be sent, and errors may be logged. **"
  1.  .. S DIR("A",4)="       **  Please log a Help Desk ticket for assistance.     **",DIR("A",5)=""
  1.  .. S DIR("A")="Do you want to set the Status to 'Don't generate or send data'" D ^DIR
  1.  .. I $G(Y) N FDA,DA S DA=1,FDA(46.5,"1,",.02)=0 D FILE^DIE(,"FDA","DGERR")
  1.  Q:$D(Y)
  1.  S DGVSTAT=$$GET1^DIQ(46.5,1,.02),DGVSTATI=$$GET1^DIQ(46.5,1,.02,"I")
  1.  W !,"Status:       ",$S(DGVSTAT'="":DGVSTAT,1:"STATUS is blank (Data is being sent to VAS)")   ; FLS Changed VSRA TO VAS 3/16/2021
  1.  S DGVPARR(2,"DG VAS BATCH SIZE")=100
  1.  S DGVPARR(8,"DG VAS DEBUGGING FLAG")=1          ; Changed XPAR names from VSRA to VAS 3/17/21
  1.  S DGVPARR(9,"DG VAS MONITOR GROUP")=$$GET^XPAR("ALL","DG VAS MONITOR GROUP")   ;JPN ADDED 3/21/21
  1.  S DGVPARR(10,"DG VAS MAX QUEUE ENTRIES")=$$GET^XPAR("ALL","DG VAS MAX QUEUE ENTRIES")
  1.  S DGVPARR(11,"DG VAS MAX WRITE ATTEMPTS")=$$GET^XPAR("ALL","DG VAS MAX WRITE ATTEMPTS")
  1.  S DGVPARR(12,"DG VAS DAYS TO KEEP EXCEPTIONS")=$$GET^XPAR("ALL","DG VAS DAYS TO KEEP EXCEPTIONS")
  1.  S DGVPNAME=""
  1.  F  S DGVPNAME=$O(DGVPARR(DGVPNAME)) Q:DGVPNAME=""  Q:'$$PROMPT($O(DGVPARR(DGVPNAME,"")),DGVPARR(DGVPNAME,$O(DGVPARR(DGVPNAME,""))))
  1.  ;JPN/FLS check for data in DGAUDIT1 if flag set to send to set DGAUDIT1 global to what is in DIA to get point forward
  1.  I (+DGCSTAT=0)&$$GET1^DIQ(46.5,1,.02,"I")=1 D
  1.  . N DGEXIEN
  1.  . S (CNTREC,FILENUM)=0,DGDATE=$$NOW^XLFDT
  1.  . S AUDGREF=$NA(^DIA),GREF=$NA(^DGAUDIT1)
  1.  . F  S FILENUM=$O(@AUDGREF@(FILENUM)) Q:'FILENUM  D  ; Fred
  1.  .. Q:'$$PATREL^DGAUDIT1(FILENUM)
  1.  .. S DGREC=$$GET1^DIQ(1.1,FILENUM,.03) Q:DGREC=""
  1.  .. K DIC S DIC="^DGAUDIT1(",X=FILENUM D ^DIC S DGEXIEN=Y
  1.  .. ; 1120 - don't reset valid pointers
  1.  .. I DGEXIEN>0 D
  1.  ... N DG1PTR S DG1PTR=$G(^DGAUDIT1(+DGEXIEN,0))
  1.  ... Q:$P(DG1PTR,"^",3)  ; Quit if pointer already defined
  1.  ... N DIK,DA S DIK="^DGAUDIT1(",DA=DGEXIEN D ^DIK  ; If pointer is not defined, remove corrputed stub, so it can be set correctly in next step
  1.  .. I '(DGEXIEN>0) D
  1.  ... K DIC,DR,DA S DIC="^DGAUDIT1(",DIC(0)="",DA=+Y,DIC("DR")=".01///"_FILENUM_";.02///"_DGREC_";.03///"_$TR($G(@AUDGREF@(FILENUM,DGREC,0)),U,"%")_";.04///"_DGDATE D FILE^DICN
  1.  ; 1120 - Send Switch Alert
  1.  I +DGCSTAT'=+DGVSTATI D
  1.  . N DGSWTXTO,DGSWTXTN,DGALRTAR,DGAUDNUM,DGINST,DGALRTLN,DGINSTXT,DGDATE,DGTIME
  1.  . S DGDATE=$$FMTE^XLFDT($$NOW^XLFDT),DGTIME=$P(DGDATE,"@",2),DGDATE=$P(DGDATE,"@")
  1.  . S DGINST=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1.  . S DGINSTXT="" I DGINST>0 D F4^XUAF4(DGINST,.DGINSTXT)
  1.  . S DGALRTLN=1
  1.  . S DGINST=DGINST_$S($$PROD^XUPROD(1):" (Prod)",1:" (Test)")
  1.  . S DGALRTAR(DGALRTLN)="The VistA Audit Solution (VAS) send status switch was changed at",DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="Station "_DGINST_" ("_$G(DGINSTXT("NAME"))_") on "_DGDATE_" at "_DGTIME,DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="",DGALRTLN=DGALRTLN+1
  1.  . S DGSWTXTO=$S(DGCSTAT=0:"Don't generate or send data",DGCSTAT=1:"Generate and send data",DGCSTAT=2:"Generate data, don't send",1:"Unknown")
  1.  . S DGSWTXTN=$S(DGVSTATI=0:"Don't generate or send data",DGVSTATI=1:"Generate and send data",DGVSTATI=2:"Generate data, don't send",1:"Unknown")
  1.  . S DGALRTAR(DGALRTLN)="New Value: '"_DGSWTXTN_"'",DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="Old Value: '"_DGSWTXTO_"'",DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="",DGALRTLN=DGALRTLN+1
  1.  . D FILE^DID(46.3,,"ENTRIES","DGAUDDATA")
  1.  . S DGAUDNUM=$G(DGAUDDATA("ENTRIES"))
  1.  . S DGALRTAR(DGALRTLN)="The ^DGAUDIT global contains "_DGAUDNUM_" entr"_$S(DGAUDNUM=1:"y",1:"ies")_".",DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="The maximum number of entries in the queue is "_$$GET^XPAR("ALL","DG VAS MAX QUEUE ENTRIES")_".",DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="["_+$G(DUZ)_"]",DGALRTLN=DGALRTLN+1
  1.  . S DGALRTAR(DGALRTLN)="",DGALRTLN=DGALRTLN+1
  1.  . D SNDMSG^DGAUDIT(.DGALRTAR,,"VAS EXPORT SWITCH ALERT")
  1.  Q
  1.  ;
  1. PROMPT(PNAME,DEFVALUE) ; Prompt for value for a given PARAMETER DEFINITION
  1.  N DIC,X,Y,DIR,ERR,XDATA,XVAR,DTOUT,DUOUT,DIROUT,DIRUT
  1.  D EDITPAR^XPAREDIT(PNAME)
  1.  I $G(DUOUT)!$G(DTOUT) W !,"quitting",! Q 0
  1.  Q 1
  1.  ;
  1. DISPLAY ; Displays the Redis Server INFO, Status and XPAR values for the Audit solution
  1.  N DA,DIC,DGVPARR,DGVPNAME,DGVSTAT,X,Y,DGWSIEN,DGWSSRV,DGEMAILI,DGEMAILE
  1.  ; Display the current values of our VAS CONFIG fields
  1.  W:$X !
  1.  S DGWSIEN=$$FIND1^DIC(18.12,,"X","DG VAS WEB SERVER")
  1.  S DGWSSRV=$$GET1^DIQ(18.12,DGWSIEN,.04)
  1.  W !,"DG VAS WEB SERVER: ",DGWSSRV
  1.  S DGVSTAT=$$GET1^DIQ(46.5,1,.02)
  1.  W !,"           STATUS: ",$S(DGVSTAT'="":DGVSTAT,1:"STATUS is blank (Data is being sent to DG VAS WEB SERVICE)"),!!
  1.  W "DG VAS BATCH SIZE: "_$$GET^XPAR("ALL","DG VAS BATCH SIZE")
  1.  W ?40,"DG VAS MAX QUEUE ENTRIES: "_$$GET^XPAR("ALL","DG VAS MAX QUEUE ENTRIES"),!
  1.  W "DG VAS MAX WRITE ATTEMPTS: "_$$GET^XPAR("ALL","DG VAS MAX WRITE ATTEMPTS")
  1.  W ?40,"DG VAS DAYS TO KEEP EXCEPTIONS: "_$$GET^XPAR("ALL","DG VAS DAYS TO KEEP EXCEPTIONS"),!
  1.  W "DG VAS DEBUG FLAG: "_$$GET^XPAR("ALL","DG VAS DEBUGGING FLAG"),!
  1.  S DGEMAILI=$$GET^XPAR("ALL","DG VAS MONITOR GROUP")
  1.  S DGEMAILE=$$GET1^DIQ(3.8,+$G(DGEMAILI),.01)
  1.  W "DG VAS MONITOR GROUP: "_DGEMAILE,!
  1.  W "RECORDS TO SEND: "_$$PENDING^DGAUDIT1,!
  1.  ;
  1.  S DIC=19.2,X="DG VAS EXPORT" D ^DIC
  1.  I Y<0 W !,"No entry found in OPTION SCHEDULING file for DG VAS EXPORT",! Q
  1.  S DIC="^DIC(19.2,",DA=+Y D EN^DIQ
  1.  Q
  1.  ;
  1. MGRPOK() ; Check for valid mail group
  1.  N DTOUT,DUOUT,Y,DGMGIEN,DGMGCOO,DGABORT,DGMGPAR,DGMGNAME,DGMGIEN
  1.  ;If mail group doesn't exist, set it up
  1.  S DGMGNAME=$$GET^XPAR("ALL","DG VAS MONITOR GROUP")
  1.  S:'$L(DGMGNAME) DGMGNAME="DG VAS MONITOR"
  1.  I $$GOTLOCAL^XMXAPIG(DGMGNAME) D  Q 1  ; Mail group exists and has active members, we're done here
  1.  . D EN^XPAR("SYS","DG VAS MONITOR GROUP",1,DGMGNAME)
  1.  S DGMGIEN=$$FIND1^DIC(3.8,"","B",DGMGNAME)
  1.  I 'DGMGIEN D MAILUSR(DGMGNAME,"O",.DGABORT) Q:$G(DGABORT) 0
  1.  D EN^XPAR("SYS","DG VAS MONITOR GROUP",1,DGMGNAME)
  1.  I '$$GOTLOCAL^XMXAPIG(DGMGNAME) D MAILUSR(DGMGNAME,"M",.DGABORT) Q:$G(DGABORT) 0
  1.  K DGMGPAR
  1.  Q 1
  1.  ;
  1. MAILUSR(DGMGNAME,DGMTYPE,DGABORT) ; Prompt for mail organizer and/or member
  1.  N DGMGCOMEM,DGMGPDS,DGMGPMY,DGMGPSL,DGMGPTP,DGMGPQT,DGMGPRS
  1.  S DGMGCOMEM=+$G(DUZ)
  1.  S DGMGPAR(1)="The '"_DGMGNAME_"' Mail Group is now being "_$S($G(DGMTYPE)="M":"updated.",1:"created.")
  1.  S DGMGPAR(2)="Mail Group members will receive notifications from the VistA Audit Solution"
  1.  S DGMGPAR(4)="(VAS). Enter the appropriate Registration Security Officer or a"
  1.  S DGMGPAR(5)="designee to be the Mail Group "_$S($G(DGMTYPE)="M":"Member",1:"Organizer.")
  1.  S DGMGPAR(6)=" "
  1.  D MES^XPDUTL(.DGMGPAR)
  1.  K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Enter Mail Group "_$S($G(DGMTYPE)="O":"Organizer: ",1:"Member: ")
  1.  S DIC("B")=DGMGCOMEM
  1.  D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) K DGMGPAR S DGABORT=1 Q
  1.  I $G(Y)>0 S DGMGCOMEM=+$G(Y)
  1.  S DGMGPMY(+$G(DGMGCOMEM))=""
  1.  S DGMGPTP=0,DGMGPSL=0,DGMGPQT=1
  1.  S DGMGPDS(1)="Members of this mail group will receive various notifications that impact"
  1.  S DGMGPDS(2)="the VistA Audit Solution (VAS) Registration application."
  1.  S DGMGPRS=$$MG^XMBGRP(DGMGNAME,DGMGPTP,DGMGCOMEM,DGMGPSL,.DGMGPMY,.DGMGPDS,DGMGPQT)
  1.  I $G(DGMTYPE)="O" I 'DGMGPRS D  Q
  1.  . D BMES^XPDUTL("Unable to create "_DGMGNAME_" Mail Group.") S DGABORT=1
  1.  . K DGMGPAR
  1.  Q