ACRFDIAC.m

ACRFDIAC ;IHS/OIRM/DSD/THL,AEF - UTILITY TO CLEAN THE AUDIT FILE OF ARMS ENTRIES; [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;UTILITY TO CLEAN THE AUDIT FILE OF ARMS ENTRIES

 ;;

EN D EN1

EXIT K ACR,ACR94

 Q

EN1 S IOP="HOME"

 D ^%ZIS

 D ^XBKVAR

 D HOME^ACRFMENU

 W @IOF

 W !!,"The AUDIT file will now be cleaned of all records greater than"

 W !,"90 days old."

 S DIR(0)="YO"

 S DIR("A")="Continue with this operations"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 S ACR94=$O(^DIC(9.4,"C","ACR",0))

 I 'ACR94 D  Q

 .W *7,*7

 .W !!,"The ARMS namespaced package was not found on this system."

 .W !,"NO Audit update will be done."

 .D PAUSE^ACRFWARN

 Q:$G(Y)'=1

 S X1=DT

 S X2=-90

 D C^%DTC

 S ACRDT=X

 S ACRFILE=0

 F  S ACRFILE=$O(^DIC(9.4,ACR94,4,"B",ACRFILE)) Q:'ACRFILE  D

 .W !,"File ",ACRFILE," being cheched."

 .S ACR=0

 .F  S ACR=$O(^DIA(ACRFILE,ACR)) Q:'ACR  D

 ..I $P(^DIA(ACRFILE,ACR,0),U,2)<ACRDT D

 ...S DA(1)=ACRFILE

 ...S DA=ACR

 ...S DIK="^DIA("_DA(1)_","

 ...D DIK^ACRFDIC

 ...W "."

 Q

ACRFDIAC  ;IHS/OIRM/DSD/THL,AEF - UTILITY TO CLEAN THE AUDIT FILE OF ARMS ENTRIES; [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;UTILITY TO CLEAN THE AUDIT FILE OF ARMS ENTRIES

 +3       ;;

EN         DO EN1

EXIT       KILL ACR,ACR94

 +1        QUIT 

EN1        SET IOP="HOME"

 +1        DO ^%ZIS

 +2        DO ^XBKVAR

 +3        DO HOME^ACRFMENU

 +4        WRITE @IOF

 +5        WRITE !!,"The AUDIT file will now be cleaned of all records greater than"

 +6        WRITE !,"90 days old."

 +7        SET DIR(0)="YO"

 +8        SET DIR("A")="Continue with this operations"

 +9        SET DIR("B")="NO"

 +10       WRITE !

 +11       DO DIR^ACRFDIC

 +12       SET ACR94=$ORDER(^DIC(9.4,"C","ACR",0))

 +13       IF 'ACR94

               Begin DoDot:1

 +14               WRITE *7,*7

 +15               WRITE !!,"The ARMS namespaced package was not found on this system."

 +16               WRITE !,"NO Audit update will be done."

 +17               DO PAUSE^ACRFWARN

               End DoDot:1

               QUIT 

 +18       IF $GET(Y)'=1

               QUIT 

 +19       SET X1=DT

 +20       SET X2=-90

 +21       DO C^%DTC

 +22       SET ACRDT=X

 +23       SET ACRFILE=0

 +24       FOR 

               SET ACRFILE=$ORDER(^DIC(9.4,ACR94,4,"B",ACRFILE))

               IF 'ACRFILE

                   QUIT 

               Begin DoDot:1

 +25               WRITE !,"File ",ACRFILE," being cheched."

 +26               SET ACR=0

 +27               FOR 

                       SET ACR=$ORDER(^DIA(ACRFILE,ACR))

                       IF 'ACR

                           QUIT 

                       Begin DoDot:2

 +28                       IF $PIECE(^DIA(ACRFILE,ACR,0),U,2)<ACRDT

                               Begin DoDot:3

 +29                               SET DA(1)=ACRFILE

 +30                               SET DA=ACR

 +31                               SET DIK="^DIA("_DA(1)_","

 +32                               DO DIK^ACRFDIC

 +33                               WRITE "."

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34       QUIT