- DGISORPT ;ALB/WJG/DHH SENSITIVE RECDS RPT;06/18/2005
- ;;5.3;Registration;**666,1015**;Aug 13, 1993;Build 21
- ;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
- DGISORPT ;ALB/WJG/DHH SENSITIVE RECDS RPT;06/18/2005
- +1 ;;5.3;Registration;**666,1015**;Aug 13, 1993;Build 21
- +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
