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