DGISORPT ;ALB/WJG/DHH SENSITIVE RECDS RPT;06/18/2005
;;5.3;Registration;**666**;Aug 13, 1993
;This was based off of a Pug Fileman template, that was tasked
;to run by the user. It was changed to incorporate the use of a
;Mail Group.
;
EN ;
K ^TMP($J),^UTILITY($J)
S U="^"
S (DGYEST,A)=9999999.9999-$$FMADD^XLFDT(DT,-1),A=A-1
F S A=$O(^DGSL(38.1,"AD",A)),A1=0 Q:'A!(A>DGYEST) F S A1=$O(^DGSL(38.1,"AD",A,A1)) Q:A1="" D
. S RECDAT=$G(^DGSL(38.1,A1,0)) Q:RECDAT=""
. S RECDAT1=$G(^DGSL(38.1,A1,"D",A,0)) Q:RECDAT1=""
. S RDATE=$P(RECDAT1,U) Q:RDATE=""
. S RDATE1=$E(RDATE,4,5)_"/"_$E(RDATE,6,7)_"/"_$E(RDATE,2,3)
. S TIME=$P(RDATE,".",2),TIME=$E(TIME_"0000",1,4)
. S RDATE1=RDATE1_"@"_TIME
. S PATNAME=$P($G(^DPT(A1,0)),U) Q:PATNAME=""
. S USERIEN=$P(RECDAT1,U,2) Q:USERIEN=""
. S OPT=$P(RECDAT1,U,3) S:OPT="" OPT=""
. S INP=$P(RECDAT1,U,4) S:INP="" INP=""
. S USERDAT=$G(^VA(200,USERIEN,0)) Q:USERDAT=""
. S USER=$E($P(USERDAT,U),1,20) Q:USER=""
. S TITLE1=$P(USERDAT,U,9) S:TITLE1="" TITLE=""
. S:TITLE1'="" TITLE=$P($G(^DIC(3.1,TITLE1,0)),U)
. S ALIAS=$P($G(^VA(200,USERIEN,3,1,0)),U)
. S SECIEN=$P($G(^VA(200,USERIEN,5)),U) S:SECIEN="" SECT=""
. S:SECIEN'="" SECT=$P($G(^DIC(49,SECIEN,0)),U) S:SECT="" SECT=""
. S:USERIEN=".5" SECT="VISTA SYSTEM"
. S:SECT'="" SECT=$E(SECT,1,20) S:ALIAS'="" ALIAS=$E(ALIAS,1,5) S:OPT'="" OPT=$E(OPT,1,25)
. S ^UTILITY($J,RDATE,A1)=PATNAME_U_RDATE1_U_USER_U_TITLE_U_ALIAS_U_SECT_U_OPT_U_INP
XMTEXT ;sets up message text
S LINE=0
S LINE=LINE+1
S ^TMP($J,LINE)="PATIENT^DATE/TIME^USER^TITLE^ALIAS^SERVICE^OPTION USED^INPATIENT"
S LINE=LINE+1
S T1=0 F S T1=$O(^UTILITY($J,T1)) Q:T1="" S T2=0 F S T2=$O(^UTILITY($J,T1,T2)) Q:T2="" D
. S TEXT=$G(^UTILITY($J,T1,T2)) Q:TEXT=""
. S ^TMP($J,LINE)=TEXT,LINE=LINE+1
NOPAT ;set message text if ^tmp($J=null
I '$D(^TMP($J,2)) D
. S ^TMP($J,2)="No Sensitive Records were accessed on "_$$FMTE^XLFDT(DT-1,1)_"."
SEND ;
S XMSUB="Sensitive Record Auditing Report"
S XMTEXT="^TMP($J,"
S XMY("G.DG ISO SENSITIVE RCDS")=""
S XMDUZ=.5 D ^XMD
K XMDUZ,XMSUB,XMTEXT,XMY,^TMP($J)
Q ;
K XMSUB,XMTEXT,XMY,XMDUZ,LINE,T1,T2,TEXT,^UTILITY($J),^TMP($J),X1,X2,RDATE,A,A1,PATNAME,RECDAT,RECDAT1,USER
K TITLE,TITLE1,OPT,INP,USERDAT,SECT,ALIAS,USERIEN,X,Y,SECIEN,TIME,RDATE1,DGYEST
Q
S DGCNT=$G(DGCNT)+1
I DGCNT=1 W !,"PATIENT^DATE/TIME^USER^TITLE^ALIAS^SERVICE^OPTION USED^INPATIENT",!
; DGCNT is killed upon exiting DG SENSITIVE RCDS RPT-EXPORT option
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGISORPT 2554 printed Dec 13, 2024@02:44 Page 2
DGISORPT ;ALB/WJG/DHH SENSITIVE RECDS RPT;06/18/2005
+1 ;;5.3;Registration;**666**;Aug 13, 1993
+2 ;This was based off of a Pug Fileman template, that was tasked
+3 ;to run by the user. It was changed to incorporate the use of a
+4 ;Mail Group.
+5 ;
EN ;
+1 KILL ^TMP($JOB),^UTILITY($JOB)
+2 SET U="^"
+3 SET (DGYEST,A)=9999999.9999-$$FMADD^XLFDT(DT,-1)
SET A=A-1
+4 FOR
SET A=$ORDER(^DGSL(38.1,"AD",A))
SET A1=0
if 'A!(A>DGYEST)
QUIT
FOR
SET A1=$ORDER(^DGSL(38.1,"AD",A,A1))
if A1=""
QUIT
Begin DoDot:1
+5 SET RECDAT=$GET(^DGSL(38.1,A1,0))
if RECDAT=""
QUIT
+6 SET RECDAT1=$GET(^DGSL(38.1,A1,"D",A,0))
if RECDAT1=""
QUIT
+7 SET RDATE=$PIECE(RECDAT1,U)
if RDATE=""
QUIT
+8 SET RDATE1=$EXTRACT(RDATE,4,5)_"/"_$EXTRACT(RDATE,6,7)_"/"_$EXTRACT(RDATE,2,3)
+9 SET TIME=$PIECE(RDATE,".",2)
SET TIME=$EXTRACT(TIME_"0000",1,4)
+10 SET RDATE1=RDATE1_"@"_TIME
+11 SET PATNAME=$PIECE($GET(^DPT(A1,0)),U)
if PATNAME=""
QUIT
+12 SET USERIEN=$PIECE(RECDAT1,U,2)
if USERIEN=""
QUIT
+13 SET OPT=$PIECE(RECDAT1,U,3)
if OPT=""
SET OPT=""
+14 SET INP=$PIECE(RECDAT1,U,4)
if INP=""
SET INP=""
+15 SET USERDAT=$GET(^VA(200,USERIEN,0))
if USERDAT=""
QUIT
+16 SET USER=$EXTRACT($PIECE(USERDAT,U),1,20)
if USER=""
QUIT
+17 SET TITLE1=$PIECE(USERDAT,U,9)
if TITLE1=""
SET TITLE=""
+18 if TITLE1'=""
SET TITLE=$PIECE($GET(^DIC(3.1,TITLE1,0)),U)
+19 SET ALIAS=$PIECE($GET(^VA(200,USERIEN,3,1,0)),U)
+20 SET SECIEN=$PIECE($GET(^VA(200,USERIEN,5)),U)
if SECIEN=""
SET SECT=""
+21 if SECIEN'=""
SET SECT=$PIECE($GET(^DIC(49,SECIEN,0)),U)
if SECT=""
SET SECT=""
+22 if USERIEN=".5"
SET SECT="VISTA SYSTEM"
+23 if SECT'=""
SET SECT=$EXTRACT(SECT,1,20)
if ALIAS'=""
SET ALIAS=$EXTRACT(ALIAS,1,5)
if OPT'=""
SET OPT=$EXTRACT(OPT,1,25)
+24 SET ^UTILITY($JOB,RDATE,A1)=PATNAME_U_RDATE1_U_USER_U_TITLE_U_ALIAS_U_SECT_U_OPT_U_INP
End DoDot:1
XMTEXT ;sets up message text
+1 SET LINE=0
+2 SET LINE=LINE+1
+3 SET ^TMP($JOB,LINE)="PATIENT^DATE/TIME^USER^TITLE^ALIAS^SERVICE^OPTION USED^INPATIENT"
+4 SET LINE=LINE+1
+5 SET T1=0
FOR
SET T1=$ORDER(^UTILITY($JOB,T1))
if T1=""
QUIT
SET T2=0
FOR
SET T2=$ORDER(^UTILITY($JOB,T1,T2))
if T2=""
QUIT
Begin DoDot:1
+6 SET TEXT=$GET(^UTILITY($JOB,T1,T2))
if TEXT=""
QUIT
+7 SET ^TMP($JOB,LINE)=TEXT
SET LINE=LINE+1
End DoDot:1
NOPAT ;set message text if ^tmp($J=null
+1 IF '$DATA(^TMP($JOB,2))
Begin DoDot:1
+2 SET ^TMP($JOB,2)="No Sensitive Records were accessed on "_$$FMTE^XLFDT(DT-1,1)_"."
End DoDot:1
SEND ;
+1 SET XMSUB="Sensitive Record Auditing Report"
+2 SET XMTEXT="^TMP($J,"
+3 SET XMY("G.DG ISO SENSITIVE RCDS")=""
+4 SET XMDUZ=.5
DO ^XMD
+5 KILL XMDUZ,XMSUB,XMTEXT,XMY,^TMP($JOB)
Q ;
+1 KILL XMSUB,XMTEXT,XMY,XMDUZ,LINE,T1,T2,TEXT,^UTILITY($JOB),^TMP($JOB),X1,X2,RDATE,A,A1,PATNAME,RECDAT,RECDAT1,USER
+2 KILL TITLE,TITLE1,OPT,INP,USERDAT,SECT,ALIAS,USERIEN,X,Y,SECIEN,TIME,RDATE1,DGYEST
+3 QUIT
+1 SET DGCNT=$GET(DGCNT)+1
+2 IF DGCNT=1
WRITE !,"PATIENT^DATE/TIME^USER^TITLE^ALIAS^SERVICE^OPTION USED^INPATIENT",!
+3 ; DGCNT is killed upon exiting DG SENSITIVE RCDS RPT-EXPORT option
+4 QUIT
