- PRC1358C ;WOIFO/LKG-1358 COMPLIANCE REPORTS ;9/21/10 09:57
- ;;5.1;IFCAP;**130,148**;Oct 20, 2000;Build 5
- ;Per VHA Directive 2004-038, this routine should not be modified.
- IN1 ;Entry point for execution of scheduled 1358 compliance reports and
- ;start of logic for 1358 Separation of Duties Violations report
- N PRCDOW S PRCDOW=$$DOW^XLFDT($$NOW^XLFDT,1) Q:PRCDOW=0 ;Quit if Sunday
- N L,DIOBEG,DIOEND,DIC,DISUPNO,FLDS,BY,FR,TO,IOP,XMQUIET,XMDUZ,XMSUB,XMY
- S L=0,DIC=410,BY="[PRC SEPARATION VIOLATE]",FLDS="[PRC 1358 SEPARATION VIOL]"
- ;Set FR to "T-2" for Monday's output and "T-1" for other days
- S FR=$S(PRCDOW=1:"T-2",1:"T-1"),TO="T-1",IOP="P-MESSAGE-HFS;79"
- S XMQUIET=1,XMDUZ="1358 EXAMINER",XMSUB="1358 SEPARATION OF DUTIES VIOLATIONS"
- S XMY("G.PRC 1358 MONITORS")=""
- D EN1^DIP
- IN2 ;Start of code for Missing Fields report
- Q ;The Missing Fields Report (1358) [PRC 1358 MISSING FIELDS] has been removed.
- ;
- IN3 ;Entry point for user interactive 1358 Separation of Duties Violations report
- N L,DIOBEG,DIOEND,DIC,DIPCRIT,DISUPNO,FLDS,BY,FR,TO,IOP,X S DIPCRIT=1
- S DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF",DIOEND="R:$E(IOST,1,2)=""C-"" !,""Press RETURN to continue..."",X:DTIME"
- S L=0,DIC=410,BY="[PRC SEPARATION VIOLATE]",FLDS="[PRC 1358 SEPARATION VIOL]"
- D EN1^DIP
- Q
- ;
- IN4 ;Entry point for user interactive Missing 1358 Fields report
- N X W !!,"The Missing Fields Report (1358) [PRC 1358 MISSING FIELDS] has been deleted.",!?10,"Hit <RETURN> to continue... " R X:DTIME
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC1358C 1509 printed Feb 18, 2025@23:25:44 Page 2
- PRC1358C ;WOIFO/LKG-1358 COMPLIANCE REPORTS ;9/21/10 09:57
- +1 ;;5.1;IFCAP;**130,148**;Oct 20, 2000;Build 5
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- IN1 ;Entry point for execution of scheduled 1358 compliance reports and
- +1 ;start of logic for 1358 Separation of Duties Violations report
- +2 ;Quit if Sunday
- NEW PRCDOW
- SET PRCDOW=$$DOW^XLFDT($$NOW^XLFDT,1)
- if PRCDOW=0
- QUIT
- +3 NEW L,DIOBEG,DIOEND,DIC,DISUPNO,FLDS,BY,FR,TO,IOP,XMQUIET,XMDUZ,XMSUB,XMY
- +4 SET L=0
- SET DIC=410
- SET BY="[PRC SEPARATION VIOLATE]"
- SET FLDS="[PRC 1358 SEPARATION VIOL]"
- +5 ;Set FR to "T-2" for Monday's output and "T-1" for other days
- +6 SET FR=$SELECT(PRCDOW=1:"T-2",1:"T-1")
- SET TO="T-1"
- SET IOP="P-MESSAGE-HFS;79"
- +7 SET XMQUIET=1
- SET XMDUZ="1358 EXAMINER"
- SET XMSUB="1358 SEPARATION OF DUTIES VIOLATIONS"
- +8 SET XMY("G.PRC 1358 MONITORS")=""
- +9 DO EN1^DIP
- IN2 ;Start of code for Missing Fields report
- +1 ;The Missing Fields Report (1358) [PRC 1358 MISSING FIELDS] has been removed.
- QUIT
- +2 ;
- IN3 ;Entry point for user interactive 1358 Separation of Duties Violations report
- +1 NEW L,DIOBEG,DIOEND,DIC,DIPCRIT,DISUPNO,FLDS,BY,FR,TO,IOP,X
- SET DIPCRIT=1
- +2 SET DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF"
- SET DIOEND="R:$E(IOST,1,2)=""C-"" !,""Press RETURN to continue..."",X:DTIME"
- +3 SET L=0
- SET DIC=410
- SET BY="[PRC SEPARATION VIOLATE]"
- SET FLDS="[PRC 1358 SEPARATION VIOL]"
- +4 DO EN1^DIP
- +5 QUIT
- +6 ;
- IN4 ;Entry point for user interactive Missing 1358 Fields report
- +1 NEW X
- WRITE !!,"The Missing Fields Report (1358) [PRC 1358 MISSING FIELDS] has been deleted.",!?10,"Hit <RETURN> to continue... "
- READ X:DTIME
- +2 QUIT