| 1 | DGISORPT ;ALB/WJG/DHH SENSITIVE RECDS RPT;06/18/2005
|
|---|
| 2 | ;;5.3;Registration;**666**;Aug 13, 1993
|
|---|
| 3 | ;This was based off of a Pug Fileman template, that was tasked
|
|---|
| 4 | ;to run by the user. It was changed to incorporate the use of a
|
|---|
| 5 | ;Mail Group.
|
|---|
| 6 | ;
|
|---|
| 7 | EN ;
|
|---|
| 8 | K ^TMP($J),^UTILITY($J)
|
|---|
| 9 | S U="^"
|
|---|
| 10 | S (DGYEST,A)=9999999.9999-$$FMADD^XLFDT(DT,-1),A=A-1
|
|---|
| 11 | 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
|
|---|
| 12 | . S RECDAT=$G(^DGSL(38.1,A1,0)) Q:RECDAT=""
|
|---|
| 13 | . S RECDAT1=$G(^DGSL(38.1,A1,"D",A,0)) Q:RECDAT1=""
|
|---|
| 14 | . S RDATE=$P(RECDAT1,U) Q:RDATE=""
|
|---|
| 15 | . S RDATE1=$E(RDATE,4,5)_"/"_$E(RDATE,6,7)_"/"_$E(RDATE,2,3)
|
|---|
| 16 | . S TIME=$P(RDATE,".",2),TIME=$E(TIME_"0000",1,4)
|
|---|
| 17 | . S RDATE1=RDATE1_"@"_TIME
|
|---|
| 18 | . S PATNAME=$P($G(^DPT(A1,0)),U) Q:PATNAME=""
|
|---|
| 19 | . S USERIEN=$P(RECDAT1,U,2) Q:USERIEN=""
|
|---|
| 20 | . S OPT=$P(RECDAT1,U,3) S:OPT="" OPT=""
|
|---|
| 21 | . S INP=$P(RECDAT1,U,4) S:INP="" INP=""
|
|---|
| 22 | . S USERDAT=$G(^VA(200,USERIEN,0)) Q:USERDAT=""
|
|---|
| 23 | . S USER=$E($P(USERDAT,U),1,20) Q:USER=""
|
|---|
| 24 | . S TITLE1=$P(USERDAT,U,9) S:TITLE1="" TITLE=""
|
|---|
| 25 | . S:TITLE1'="" TITLE=$P($G(^DIC(3.1,TITLE1,0)),U)
|
|---|
| 26 | . S ALIAS=$P($G(^VA(200,USERIEN,3,1,0)),U)
|
|---|
| 27 | . S SECIEN=$P($G(^VA(200,USERIEN,5)),U) S:SECIEN="" SECT=""
|
|---|
| 28 | . S:SECIEN'="" SECT=$P($G(^DIC(49,SECIEN,0)),U) S:SECT="" SECT=""
|
|---|
| 29 | . S:USERIEN=".5" SECT="VISTA SYSTEM"
|
|---|
| 30 | . S:SECT'="" SECT=$E(SECT,1,20) S:ALIAS'="" ALIAS=$E(ALIAS,1,5) S:OPT'="" OPT=$E(OPT,1,25)
|
|---|
| 31 | . S ^UTILITY($J,RDATE,A1)=PATNAME_U_RDATE1_U_USER_U_TITLE_U_ALIAS_U_SECT_U_OPT_U_INP
|
|---|
| 32 | XMTEXT ;sets up message text
|
|---|
| 33 | S LINE=0
|
|---|
| 34 | S LINE=LINE+1
|
|---|
| 35 | S ^TMP($J,LINE)="PATIENT^DATE/TIME^USER^TITLE^ALIAS^SERVICE^OPTION USED^INPATIENT"
|
|---|
| 36 | S LINE=LINE+1
|
|---|
| 37 | 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
|
|---|
| 38 | . S TEXT=$G(^UTILITY($J,T1,T2)) Q:TEXT=""
|
|---|
| 39 | . S ^TMP($J,LINE)=TEXT,LINE=LINE+1
|
|---|
| 40 | NOPAT ;set message text if ^tmp($J=null
|
|---|
| 41 | I '$D(^TMP($J,2)) D
|
|---|
| 42 | . S ^TMP($J,2)="No Sensitive Records were accessed on "_$$FMTE^XLFDT(DT-1,1)_"."
|
|---|
| 43 | SEND ;
|
|---|
| 44 | S XMSUB="Sensitive Record Auditing Report"
|
|---|
| 45 | S XMTEXT="^TMP($J,"
|
|---|
| 46 | S XMY("G.DG ISO SENSITIVE RCDS")=""
|
|---|
| 47 | S XMDUZ=.5 D ^XMD
|
|---|
| 48 | K XMDUZ,XMSUB,XMTEXT,XMY,^TMP($J)
|
|---|
| 49 | Q ;
|
|---|
| 50 | K XMSUB,XMTEXT,XMY,XMDUZ,LINE,T1,T2,TEXT,^UTILITY($J),^TMP($J),X1,X2,RDATE,A,A1,PATNAME,RECDAT,RECDAT1,USER
|
|---|
| 51 | K TITLE,TITLE1,OPT,INP,USERDAT,SECT,ALIAS,USERIEN,X,Y,SECIEN,TIME,RDATE1,DGYEST
|
|---|
| 52 | Q
|
|---|
| 53 | HEADER ;Header for export option
|
|---|
| 54 | S DGCNT=$G(DGCNT)+1
|
|---|
| 55 | I DGCNT=1 W !,"PATIENT^DATE/TIME^USER^TITLE^ALIAS^SERVICE^OPTION USED^INPATIENT",!
|
|---|
| 56 | ; DGCNT is killed upon exiting DG SENSITIVE RCDS RPT-EXPORT option
|
|---|
| 57 | Q
|
|---|
