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

DGAUDIT2.m

Go to the documentation of this file.
  1. DGAUDIT2 ;PER/LAB,ISL/DKA - Patient Lookup Audit Report for VAS ;May 17, 2021@12:09
  1. ;;5.3;Registration;**964,1097,1108**;Aug 13, 1993;Build 17
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to FILE^DICN in ICR #10009
  1. ; Reference to $$GETICN^MPIF001 in ICR #2701
  1. ; Reference to $$STA^XUAF4 in ICR #2171
  1. ; Reference to $$KSP^XUPARAM in ICR #2541
  1. ; Reference to ^XLFJSON in ICR #6682
  1. ; Reference to $$GET^XPAR in ICR #2263
  1. ;
  1. Q ; No entry from top
  1. ;
  1. SELAUD(DGVFILNO,DGVDFN,REQTYP,DGOPT) ;Audit Patient records at selection
  1. ; VistA Security Remediation
  1. ; When a patient is manually selected to be viewed or edited, an
  1. ; audit record will be created.
  1. S:'$G(DGAUDMAX) DGAUDMAX=$$GET^XPAR("ALL","DG VAS MAX QUEUE ENTRIES")
  1. Q:$$PENDING^DGAUDIT1'<DGAUDMAX
  1. Q:$G(DGVDFN)="" ; if new patient, cannot display information
  1. Q:$$ANON^DGAUDIT1(DUZ) ; anonymous/proxy user don't continue
  1. S DGVDFN=+DGVDFN
  1. Q:'$$FIND1^DIC(2,"","A","`"_DGVDFN)
  1. ;
  1. ; D CHKSIZE^DGAUDIT,SNDMSG^DGAUDIT(.DGAUDERR) 2/23 took out cannot add here as this will be checked at install and not let the full dia global be populated
  1. N DA,DIC,NINUM,DO,DTOUT,DUOUT,INDX,LFLAG,MENUOPT,X,DGVECNT,Y,DIY,DIX
  1. S MENUOPT=$S($L($P($G(DGOPT),"^")):$P($G(DGOPT),"^"),$L($P($G(DGOPT),"^",2)):$P($G(DGOPT),"^",2),$L($P($G(XQY0),"^")):$P($G(XQY0),"^"),1:"UNKNOWN/NON-STANDARD")
  1. ;
  1. D PROCJSON(REQTYP,DGVDFN,$G(DUZ),$G(MENUOPT),$G(DGVFILNO),$G(DUZ(2)))
  1. Q
  1. ;
  1. ;PROCJSON(DGAUDECNT) ; Create the JSON from the individual fields in the DGAUD AUDIT QUEUE record
  1. PROCJSON(REQTYP,DGVDFN,DUZ,MENUOPT,DGVFILNO,DUZ2) ; Create the JSON from the individual fields in the DGAUD AUDIT QUEUE record
  1. ; ISL/DKA This copy is for playing around with using only FileMan calls to get the data
  1. N D,D0,DA,DI,DIC,DIE,DIERR,DO,DQ,DR,X,DGARR,DGAUDARR,DGAUDDATA,DGAUDDFN,DGAUDDT,DGAUDDUZ,DGAUDERR
  1. N DGAUDFILE,DGAUDFILNO,DGAUDJSON,DGAUDOFFN,DGAUDREF,DGAUDSITEN,DGAUDSTANUM,Y,DGFDA,DGMVI,DGERR
  1. N DGFDA,DGNOWDTM,DGAUDERR,DGAUDECNT,DGFILNAME,DGCTRL,DGSTA,JSONERR,DGAUDIEN
  1. N DGSTATION,DGSITENAM,DGSITEIEN,DGRESULT,TMPJSON
  1. ;
  1. S DGAUDECNT="+1"
  1. S DGNOWDTM=$$NOW^XLFDT
  1. D FILE^DID(DGVFILNO,,"NAME","DGFILNAME","DGERR")
  1. ;
  1. N I F I=0:1:31 S DGCTRL=$G(DGCTRL)_$c(I) ; Build string of non-printable control characters
  1. S DGFDA(46.3,DGAUDECNT_",",.01)=DGNOWDTM
  1. ;
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.02,"E")=$G(REQTYP)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.03,"E")=$$FMTE^XLFDT(DGNOWDTM,2)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.04,"E")=$$GET1^DIQ(2,+$G(DGVDFN),.01)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.05,"E")=$$GET1^DIQ(200,$G(DUZ),.01)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.06,"E")=$TR($G(MENUOPT),DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.07,"E")=$TR($G(DGFILNAME("NAME"),"UNKNOWN"),DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.08,"E")=$TR($$GET1^DIQ(4,+$G(DUZ2),.01),DGCTRL)
  1. ;
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.02,"I")=$TR($E($G(REQTYP)),DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.03,"I")=DGNOWDTM
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.04,"I")=$TR(DGVDFN,DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.05,"I")=$TR($G(DUZ),DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.06,"I")=$TR($$FIND1^DIC(19,,,$G(MENUOPT)),DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.07,"I")=$TR($G(DGVFILNO),DGCTRL)
  1. S DGAUDDATA(46.3,DGAUDECNT_",",.08,"I")=$TR(DUZ2,DGCTRL)
  1. ;
  1. S DGFDA(46.3,DGAUDECNT_",",.02)=$E($G(REQTYP))
  1. S DGFDA(46.3,DGAUDECNT_",",.03)=DGNOWDTM
  1. S DGFDA(46.3,DGAUDECNT_",",.04)=$TR($G(DGVDFN),DGCTRL)
  1. S DGFDA(46.3,DGAUDECNT_",",.05)=$TR($G(DUZ),DGCTRL)
  1. S DGFDA(46.3,DGAUDECNT_",",.06)=$TR(DGAUDDATA(46.3,DGAUDECNT_",",.06,"I"),DGCTRL)
  1. S DGFDA(46.3,DGAUDECNT_",",.07)=$TR($G(DGVFILNO),DGCTRL)
  1. S DGFDA(46.3,DGAUDECNT_",",.08)=$TR(DUZ2,DGCTRL)
  1. ;
  1. ;
  1. S DGARR=$NA(DGAUDARR("data","HEADER"))
  1. D GETS^DIQ(46.3,DGAUDECNT,"*","IE","DGAUDDATA")
  1. ; Set DGAUDREF for use with indirection below to get each individual field from the returned array.
  1. S DGAUDREF=$NA(DGAUDDATA(46.3,DGAUDECNT_","))
  1. ;
  1. S @DGARR@("SchemaType")="FMAUDIT"
  1. S @DGARR@("RequestType")=$TR(@DGAUDREF@(.02,"E"),DGCTRL)
  1. S @DGARR@("DateTime")=$$FMTHL7^XLFDT(@DGAUDREF@(.03,"I"))
  1. S DGAUDDT=$TR(@DGAUDREF@(.03,"I"),DGCTRL)
  1. S @DGARR@("Week")=$TR($$WEEK^DGAUDIT1(DGAUDDT),DGCTRL)
  1. S @DGARR@("Year")=+$$FMTE^XLFDT(DGAUDDT,7)
  1. ;
  1. S DGARR=$NA(DGAUDARR("data","HEADER","Patient"))
  1. S (DGAUDDFN,@DGARR@("DFN"))=$TR(@DGAUDREF@(.04,"I"),DGCTRL)
  1. S DGMVI=$$GETICN^MPIF001(DGAUDDFN),DGMVI=$S(DGMVI>0:DGMVI,1:"") ;$$GET1^DIQ(2,DGAUDDFN,991.1)
  1. S @DGARR@("MVI")=$S($L(DGMVI):DGMVI,1:"null")
  1. S @DGARR@("PatientName")=$TR(@DGAUDREF@(.04,"E"),DGCTRL)
  1. S @DGARR@("SSN")=$TR($$GET1^DIQ(2,DGAUDDFN,.09),DGCTRL)
  1. S @DGARR@("INITPLUS4")=$TR($$GET1^DIQ(2,DGAUDDFN,.0905),DGCTRL)
  1. S @DGARR@("DOB")=$$FMTHL7^XLFDT($$GET1^DIQ(2,DGAUDDFN,.03,"I"))
  1. ;
  1. S DGARR=$NA(DGAUDARR("data","HEADER","User"))
  1. S (DGAUDDUZ,@DGARR@("DUZ"))=$TR(@DGAUDREF@(.05,"I"),DGCTRL)
  1. S @DGARR@("UID")=$TR($$GET1^DIQ(200,DGAUDDUZ,205.4),DGCTRL)
  1. S @DGARR@("UserName")=$TR($$GET1^DIQ(200,DGAUDDUZ,.01),DGCTRL)
  1. S @DGARR@("Title")=$TR($$GET1^DIQ(200,DGAUDDUZ,8),DGCTRL)
  1. ;
  1. S DGARR=$NA(DGAUDARR("data","HEADER","Location"))
  1. S DGAUDSITEN=@DGAUDREF@(.08,"I")
  1. I DGAUDSITEN="",DGAUDDUZ'="" S DGAUDSITEN=$O(^VA(200,DGAUDDUZ,2,"AX1",1,"")) ; Checking to make sure that DGAUDDUZ is not null to avoid a subscript FLS
  1. S:DGAUDSITEN="" DGAUDSITEN=$$GET1^DIQ(8989.3,1,217,"I")
  1. S DGAUDOFFN=$$GET1^DIQ(4,DGAUDSITEN,100)
  1. S @DGARR@("Site")=$S(DGAUDOFFN'="":$TR(DGAUDOFFN,DGCTRL),1:$TR(@DGAUDREF@(.08,"E"),DGCTRL))
  1. S DGAUDSTANUM=$TR($$GET1^DIQ(4,DGAUDSITEN,99),DGCTRL)
  1. I DGAUDSTANUM="" S DGAUDSTANUM=$$GET1^DIQ(4,$$GET1^DIQ(8989.3,1,217,"I"),99)
  1. S @DGARR@("StationNumber")=$TR(DGAUDSTANUM,DGCTRL)
  1. ;
  1. S DGARR=$NA(DGAUDARR("data","SCHEMA"))
  1. S (DGAUDFILNO,@DGARR@("FILE NUMBER"))=@DGAUDREF@(.07,"I")
  1. S @DGARR@("FILE NAME")=$TR(@DGAUDREF@(.07,"E"),DGCTRL)
  1. S @DGARR@("ACCESSED")="INQUIRED TO ENTRY"
  1. S @DGARR@("MENU OPTION USED")=$TR(@DGAUDREF@(.06,"E"),DGCTRL)
  1. ;
  1. S DGARR=$NA(DGAUDARR("id"))
  1. S @DGARR=+$G(DUZ)_"."_+$G(DGVDFN)_"."_+DGNOWDTM
  1. ;
  1. S DGARR=$NA(DGAUDARR("station"))
  1. S DGSTATION=$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1. S @DGARR=DGSTATION
  1. S DGARR=$NA(DGAUDARR("site"))
  1. S DGSITEIEN=$$FIND1^DIC(4,,"X",DGSTATION,"D")
  1. S DGSITENAM=$$GET1^DIQ(4,DGSITEIEN,.01)
  1. S @DGARR=DGSITENAM
  1. ;
  1. D ENCODE^XLFJSON("DGAUDARR","DGAUDJSON","JSONERR")
  1. I '$G(JSONERR) D DECODE^XLFJSON("DGAUDJSON","TMPJSON","JSONERR")
  1. S DGFDA(46.3,DGAUDECNT_",",1)=DGAUDJSON(1)
  1. ;
  1. I ($L(DGFDA(46.3,DGAUDECNT_",",1))<30)!$G(JSONERR(0)) D Q
  1. . N DGERRCAP M DGERRCAP=DGFDA M DGERRCAP(46.3,DGAUDECNT_",",1)=DGAUDARR
  1. . I $G(JSONERR(0)) S JSONERR=0 F S JSONERR=$O(JSONERR(JSONERR)) Q:'JSONERR S DGERRCAP(46.3,DGAUDECNT_",",1,"JSON ERROR",.999+JSONERR)=$G(JSONERR(JSONERR))
  1. . D BADJSON(0,+$G(DGAUDKPX),.DGERRCAP)
  1. D UPDATE^DIE("S","DGFDA","DGAUDIEN","DGRESULT") S DGAUDIEN=$G(DGAUDIEN(1))
  1. I 'DGAUDIEN!'$L($G(^DGAUDIT(+DGAUDIEN,1))) D
  1. . N DGERRCAP M DGERRCAP=DGFDA M DGERRCAP(46.3,DGAUDECNT_",",1)=DGAUDARR
  1. . I $D(DGRESULT("DIERR",1,"TEXT")) S DGERRCAP(46.3,DGAUDECNT_",",1,"JSON ERROR",.999)="FileMan Filer Error: "_$G(DGRESULT("DIERR",1,"TEXT",1))
  1. . D BADJSON(+$G(DGAUDIEN),+$G(DGAUDKPX),.DGERRCAP)
  1. Q
  1. ;
  1. BADJSON(DGAUDCNT,DGAUDKPX,DGFDA) ; Purge bad JSON, send message
  1. N DGERR,DGXNODE,DGNOW,DGHEADER,DGEMPTY S DGERR=1,DGNOW=$$NOW^XLFDT
  1. S DGERR(DGERR)=" An audit record with missing or invalid JSON data was "_$S($G(DGAUDCNT):"purged from",1:"not added to"),DGERR=DGERR+1
  1. S DGERR(DGERR)=" the VAS queue. See ^XTMP(""DGAUDIT_EXCEPTION;"_DGNOW_"."_DGAUDCNT_"""",DGERR=DGERR+1
  1. S DGERR(DGERR)=" for more information. ",DGERR=DGERR+1
  1. S DGERR(DGERR)=" Header information: ",DGERR=DGERR+1
  1. ;
  1. I $G(DGAUDCNT) D
  1. . N DGREQUEST,DGOPTION,DGDECODE,DGTMPJSON,DGJSONERR
  1. . S DGTMPJSON=$G(^DGAUDIT(DGAUDCNT,1)) I $L(DGTMPJSON) D DECODE^XLFJSON("DGTMPJSON","DGDECODE","DGJSONERR")
  1. . S DGREQUEST=$G(DGFDA(46.3,"+1,",1,"data","HEADER","RequestType")) I '$L(DGREQUEST) S DGREQUEST=$G(DGDECODE(46.3,"+1,",1,"data","HEADER","RequestType"))
  1. . S DGOPTION=$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","MENU OPTION USED")) I '$L(DGOPTION) S DGOPTION=$G(DGDECODE(46.3,"+1,",1,"data","SCHEMA","MENU OPTION USED"))
  1. . I '$L(DGREQUEST),'$L(DGOPTION) S DGEMPTY=1 Q ; Need Request Type and Menu Option, or consider this an empty payload
  1. . S DGERR(DGERR)=" "_$G(^DGAUDIT(DGAUDCNT,0)),DGERR=DGERR+1
  1. . S DGERR(DGERR)="Request Type: "_$G(DGFDA(46.3,"+1,",1,"data","HEADER","RequestType")),DGERR=DGERR+1
  1. . S DGERR(DGERR)="File Name: "_$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","FILE NAME")),DGERR=DGERR+1
  1. . S DGERR(DGERR)="File Number: "_$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","FILE NUMBER")),DGERR=DGERR+1
  1. . S DGERR(DGERR)="Menu Option Used: "_$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","MENU OPTION USED")),DGERR=DGERR+1
  1. I '$G(DGAUDCNT) D
  1. . ; If there is no JSON payload, don't generate error, there is not enought info to report
  1. . I '$L($G(DGFDA(46.3,"+1,",1,"data","HEADER","RequestType")))!'$L($G(DGFDA(46.3,"+1,",1,"data","SCHEMA","MENU OPTION USED"))) S DGEMPTY=1 Q
  1. . ; Pull raw data out of array
  1. . N DGI,DGFIELD S DGFIELD="" F DGI=1:1 S DGFIELD=$O(DGFDA(46.3,"+1,",DGFIELD)) Q:DGFIELD="" D
  1. .. I DGFIELD<1 S DGHEADER=$S(DGI=1:DGFDA(46.3,"+1,",DGFIELD),1:$G(DGHEADER)_"^"_DGFDA(46.3,"+1,",DGFIELD)),DGERR(DGERR)=" "_DGHEADER
  1. .. I DGFIELD=1 S DGERR=DGERR+1 D
  1. ... S DGERR(DGERR)="Request Type: "_$G(DGFDA(46.3,"+1,",1,"data","HEADER","RequestType")),DGERR=DGERR+1
  1. ... S DGERR(DGERR)="File Name: "_$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","FILE NAME")),DGERR=DGERR+1
  1. ... S DGERR(DGERR)="File Number: "_$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","FILE NUMBER")),DGERR=DGERR+1
  1. ... S DGERR(DGERR)="Menu Option Used: "_$G(DGFDA(46.3,"+1,",1,"data","SCHEMA","MENU OPTION USED")),DGERR=DGERR+1
  1. ;
  1. I '$G(DGEMPTY) D GENERR^DGAUDIT1(.DGERR) D
  1. . ; DGAUDKPX = Days to keep exception JSON in ^XTMP : "DG VAS DAYS TO KEEP EXCEPTIONS" parameter
  1. . S DGAUDKPX=$S($G(DGAUDKPX):DGAUDKPX,1:3)
  1. . S DGXNODE="DGAUDIT_EXCEPTION;"_DGNOW_"."_DGAUDCNT
  1. . S ^XTMP(DGXNODE,0)=$$FMADD^XLFDT($$DT^XLFDT(),DGAUDKPX)_"^"_$$DT^XLFDT()_"^VAS Server Exceptions: Invalid JSON"
  1. . S ^XTMP(DGXNODE,0,0)=$S($G(DGAUDCNT):$G(^DGAUDIT(DGAUDCNT,0)),1:$G(DGHEADER))
  1. . I $G(DGAUDCNT) S ^XTMP(DGXNODE,0,1)=$G(^DGAUDIT(DGAUDCNT,1))
  1. . M ^XTMP(DGXNODE,"DGFDA")=DGFDA Q
  1. ;
  1. Q:'$G(DGAUDCNT) ; Nothing to delete, caught before being placed in queue
  1. ;
  1. ; Delete Record Exceptions From ^DGAUDIT
  1. N DIK,DA S DIK="^DGAUDIT(",DA=DGAUDCNT D ^DIK
  1. Q