ACRFCLOS.m

ACRFCLOS ;IHS/OIRM/DSD/THL,AEF - UTILITY TO CLOSE FISCAL YEAR ACCOUNTS; [ 09/23/2005   9:44 AM ]

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

EN D EN1

EXIT K ACR,ACRXYR

 Q

EN1 ;SPECIFY FISCAL YEAR

 W @IOF

 W !,"This utility will allow you to delete user access to DEPARTMENT ACCOUNTS"

 W !,"for a selected fiscal year."

 W !!,"You should NOT do this until you have created your next fiscal year accounts."

 W !,"If you have completed this process, proceed with closing DEPARTMENT ACCOUNTS."

 S DIR(0)="NOA^1000:9999"

 S DIR("A")="Fiscal Year: "

 S DIR("?")="Enter the four digit fiscal year for which you want to delete account access."

 W !

 D DIR^ACRFDIC

 Q:Y<1

 S ACRFY=Y

 D EX

 D ALL

 Q

ALL ;DECIDE WHETHER TO DELETE ACCESS TO ALL ACCOUNTS OR SELECTED ACCOUNTS

 K ACRXYR

 S DIR(0)="YO"

 S DIR("A",1)="Do you want CLOSE Multi-year and"

 S DIR("A")="'X' appropriation accounts"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)

 I Y=1 D  Q:$D(ACRQUIT)

 .S DIR(0)="YO"

 .S DIR("A",1)="Are you certain you want to CLOSE"

 .S DIR("A")="Multi-year and 'X' appropriaiton accounts."

 .S DIR("B")="NO"

 .W !

 .D DIR^ACRFDIC

 .Q:$D(ACRQUIT)

 .Q:Y'=1

 .S ACRXYR=""

 S DIR(0)="SO^1:All Department Accounts;2:Selected Department Accounts;3:One selected account"

 S DIR("A")="Which one"

 S DIR("?")="Enter the appropriate code from the list"

 S DIR("?",1)="Number '1' deletes access of users from ALL Department Accounts."

 S DIR("?",2)="Number '2' deletes access of users from ONLY selected Department Accounts."

 S DIR("?",3)="Number '3' deletes access of users from ONE selected Department Account."

 D DIR^ACRFDIC

 Q:'$D(Y)

 Q:"123"'[Y

 S ACRALL=Y

 I +Y=1 D A1 Q

 I +Y=2 D SOME Q

 I +Y=3 D SELECT Q

 Q

A1 ;PROCESS ALL DEPARTMENT ACCOUNTS FOR THE SPECIFIED FISCAL YEAR

 D CERTAIN

 Q:$D(ACRQUIT)

 W !!

 S (ACR,ACRI)=0

 F  S ACR=$O(^ACRLOCB("FY",ACRFY,ACR)) Q:'ACR  I $D(^ACRLOCB(ACR,0)) S ACR0=^(0),ACRDT=^ACRLOCB(ACR,"DT") D

 .Q:$P(ACR0,U,23)

 .S ACRI=ACRI+1

 .D DELETE

 Q

SOME ;PROCESS SELECTED DEPARTMENT ACCOUNTS

 S (ACR,ACRI)=0

 F  S ACR=$O(^ACRLOCB("FY",ACRFY,ACR)) Q:'ACR!$D(ACRQUIT)  I $D(^ACRLOCB(ACR,0)) S ACR0=^(0),ACRDT=^ACRLOCB(ACR,"DT") D

 .S ACRI=ACRI+1

 .W !!?10,"-----------------------------------------------------"

 .W !?10,"ID NO."

 .W ?19,"DEPARTMENT"

 .W ?52,"CAN"

 .W !?10,"------"

 .W ?19,"------------------------------"

 .W ?52,"-------"

 .W !?10,ACR

 .W ?19,$S($P($G(^AUTTPRG(+$P(ACR0,U,5),0)),U)]"":$P(^(0),U),1:"NOT STATED")

 .W ?52,$S($P($G(^AUTTCAN(+$P(ACRDT,U,9),0)),U)]"":$P(^(0),U),1:"NOT STATED")

 .S DIR(0)="YO"

 .S DIR("A")="Delete access to account (ID NO. "_ACR_")"

 .S DIR("B")="NO"

 .W !

 .D DIR^ACRFDIC

 .Q:Y'=1

 .D DELETE

 Q

DELETE ;DELETE USER ACCESS FROM DEPARTMENT ACCOUNT

 ;DO NOT DELETE USER ACCESS TO MULTI-YEAR ACCOUNTS

 N X

 S X=$P($G(^AUTTPRO(+$P($G(ACRDT),U,4),0)),U)

 I '$D(ACRXYR),X["X"!(X["/") Q

 W !!?10,ACR

 W ?19,$S($P($G(^AUTTPRG(+$P(ACR0,U,5),0)),U)]"":$P(^(0),U),1:"NOT STATED")

 W ?50,"<USER ACCESS DELETED>"

 S ACRDA=0

 F  S ACRDA=$O(^ACRLOCB(ACR,"SC",ACRDA)) Q:'ACRDA  D

 .I $D(^ACRLOCB(ACR,"SC",ACRDA,0)),'$D(ACREX(+^(0))) D

 ..S DA(1)=ACR

 ..S DA=ACRDA

 ..S DIK="^ACRLOCB("_ACR_",""SC""," W "."

 ..D DIK^ACRFDIC

 Q

EX ;CHOOSE USER(S) TO EXCLUDE FROM ACCOUNT ACCESS DELETE

 ;SELECT 'EMPLOYEE'

 W !!,"You may identify employees for whom access will NOT be deleted."

 W !,"The employees selected below will NOT have their account access deleted."

 F  D EX1 Q:$D(ACRQUIT)

 Q

EX1 ;CHOOSE EMPLOYEE

 S DIC="^VA(200,"

 S DIC(0)="AEMQZ"

 S DIC("A")="EMPLOYEE............: "

 S DIC("DR")=""

 W !!?21,"|" F ACRI=1:1:30 W "="

 W "|"

 D DIC^ACRFDIC

 I U[$E(X)!(+Y<1) S ACRQUIT="" Q

 S ACRDUZ=+Y

 S ACREX(+Y)=""

 ;S ACRUSER=Y(0,0)  ;ACR*2.1*19.02 IM16848

 ;S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",")  ;ACR*2.1*19.02 IM16848

 S ACRUSER=$$NAME3^ACRFUTL1(ACRDUZ)  ;ACR*2.1*19.02 IM16848

 W !!,ACRUSER," will NOT be deleted from account access."

 Q

SELECT ;SELECT SINGLE DEPARTMENT ACCOUNT FROM WHICH TO DELETE ACCESS

 S DIC="^ACRLOCB("

 S DIC(0)="AENQZ"

 S DIC("A")="Account ID NO.: "

 S DIC("?")="Enter the ID NO. of the account from which to delete access."

 W !

 D DIC^ACRFDIC

 Q:+Y<1

 I $D(^ACRLOCB(+Y,0)) D

 .S ACR=+Y,ACR0=^ACRLOCB(+Y,0),ACRDT=^ACRLOCB(+Y,"DT")

 .D CERTAIN

 .Q:$D(ACRQUIT)

 .D DELETE

 Q

CERTAIN ;CHECK TO ENSURE USER WANST TO DELETE ACCOUNT ACCESS

 S DIR(0)="YO"

 S DIR("A")="Are you CERTAIN you want to delete account access"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 S:Y'=1 ACRQUIT=""

 Q

ACRFCLOS  ;IHS/OIRM/DSD/THL,AEF - UTILITY TO CLOSE FISCAL YEAR ACCOUNTS; [ 09/23/2005   9:44 AM ]

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

EN         DO EN1

EXIT       KILL ACR,ACRXYR

 +1        QUIT 

EN1       ;SPECIFY FISCAL YEAR

 +1        WRITE @IOF

 +2        WRITE !,"This utility will allow you to delete user access to DEPARTMENT ACCOUNTS"

 +3        WRITE !,"for a selected fiscal year."

 +4        WRITE !!,"You should NOT do this until you have created your next fiscal year accounts."

 +5        WRITE !,"If you have completed this process, proceed with closing DEPARTMENT ACCOUNTS."

 +6        SET DIR(0)="NOA^1000:9999"

 +7        SET DIR("A")="Fiscal Year: "

 +8        SET DIR("?")="Enter the four digit fiscal year for which you want to delete account access."

 +9        WRITE !

 +10       DO DIR^ACRFDIC

 +11       IF Y<1

               QUIT 

 +12       SET ACRFY=Y

 +13       DO EX

 +14       DO ALL

 +15       QUIT 

ALL       ;DECIDE WHETHER TO DELETE ACCESS TO ALL ACCOUNTS OR SELECTED ACCOUNTS

 +1        KILL ACRXYR

 +2        SET DIR(0)="YO"

 +3        SET DIR("A",1)="Do you want CLOSE Multi-year and"

 +4        SET DIR("A")="'X' appropriation accounts"

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

 +6        WRITE !

 +7        DO DIR^ACRFDIC

 +8        IF $DATA(ACRQUIT)

               QUIT 

 +9        IF Y=1

               Begin DoDot:1

 +10               SET DIR(0)="YO"

 +11               SET DIR("A",1)="Are you certain you want to CLOSE"

 +12               SET DIR("A")="Multi-year and 'X' appropriaiton accounts."

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

 +14               WRITE !

 +15               DO DIR^ACRFDIC

 +16               IF $DATA(ACRQUIT)

                       QUIT 

 +17               IF Y'=1

                       QUIT 

 +18               SET ACRXYR=""

               End DoDot:1

               IF $DATA(ACRQUIT)

                   QUIT 

 +19       SET DIR(0)="SO^1:All Department Accounts;2:Selected Department Accounts;3:One selected account"

 +20       SET DIR("A")="Which one"

 +21       SET DIR("?")="Enter the appropriate code from the list"

 +22       SET DIR("?",1)="Number '1' deletes access of users from ALL Department Accounts."

 +23       SET DIR("?",2)="Number '2' deletes access of users from ONLY selected Department Accounts."

 +24       SET DIR("?",3)="Number '3' deletes access of users from ONE selected Department Account."

 +25       DO DIR^ACRFDIC

 +26       IF '$DATA(Y)

               QUIT 

 +27       IF "123"'[Y

               QUIT 

 +28       SET ACRALL=Y

 +29       IF +Y=1

               DO A1

               QUIT 

 +30       IF +Y=2

               DO SOME

               QUIT 

 +31       IF +Y=3

               DO SELECT

               QUIT 

 +32       QUIT 

A1        ;PROCESS ALL DEPARTMENT ACCOUNTS FOR THE SPECIFIED FISCAL YEAR

 +1        DO CERTAIN

 +2        IF $DATA(ACRQUIT)

               QUIT 

 +3        WRITE !!

 +4        SET (ACR,ACRI)=0

 +5        FOR 

               SET ACR=$ORDER(^ACRLOCB("FY",ACRFY,ACR))

               IF 'ACR

                   QUIT 

               IF $DATA(^ACRLOCB(ACR,0))

                   SET ACR0=^(0)

                   SET ACRDT=^ACRLOCB(ACR,"DT")

                   Begin DoDot:1

 +6                    IF $PIECE(ACR0,U,23)

                           QUIT 

 +7                    SET ACRI=ACRI+1

 +8                    DO DELETE

                   End DoDot:1

 +9        QUIT 

SOME      ;PROCESS SELECTED DEPARTMENT ACCOUNTS

 +1        SET (ACR,ACRI)=0

 +2        FOR 

               SET ACR=$ORDER(^ACRLOCB("FY",ACRFY,ACR))

               IF 'ACR!$DATA(ACRQUIT)

                   QUIT 

               IF $DATA(^ACRLOCB(ACR,0))

                   SET ACR0=^(0)

                   SET ACRDT=^ACRLOCB(ACR,"DT")

                   Begin DoDot:1

 +3                    SET ACRI=ACRI+1

 +4                    WRITE !!?10,"-----------------------------------------------------"

 +5                    WRITE !?10,"ID NO."

 +6                    WRITE ?19,"DEPARTMENT"

 +7                    WRITE ?52,"CAN"

 +8                    WRITE !?10,"------"

 +9                    WRITE ?19,"------------------------------"

 +10                   WRITE ?52,"-------"

 +11                   WRITE !?10,ACR

 +12                   WRITE ?19,$SELECT($PIECE($GET(^AUTTPRG(+$PIECE(ACR0,U,5),0)),U)]"":$PIECE(^(0),U),1:"NOT STATED")

 +13                   WRITE ?52,$SELECT($PIECE($GET(^AUTTCAN(+$PIECE(ACRDT,U,9),0)),U)]"":$PIECE(^(0),U),1:"NOT STATED")

 +14                   SET DIR(0)="YO"

 +15                   SET DIR("A")="Delete access to account (ID NO. "_ACR_")"

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

 +17                   WRITE !

 +18                   DO DIR^ACRFDIC

 +19                   IF Y'=1

                           QUIT 

 +20                   DO DELETE

                   End DoDot:1

 +21       QUIT 

DELETE    ;DELETE USER ACCESS FROM DEPARTMENT ACCOUNT

 +1       ;DO NOT DELETE USER ACCESS TO MULTI-YEAR ACCOUNTS

 +2        NEW X

 +3        SET X=$PIECE($GET(^AUTTPRO(+$PIECE($GET(ACRDT),U,4),0)),U)

 +4        IF '$DATA(ACRXYR)

               IF X["X"!(X["/")

                   QUIT 

 +5        WRITE !!?10,ACR

 +6        WRITE ?19,$SELECT($PIECE($GET(^AUTTPRG(+$PIECE(ACR0,U,5),0)),U)]"":$PIECE(^(0),U),1:"NOT STATED")

 +7        WRITE ?50,"<USER ACCESS DELETED>"

 +8        SET ACRDA=0

 +9        FOR 

               SET ACRDA=$ORDER(^ACRLOCB(ACR,"SC",ACRDA))

               IF 'ACRDA

                   QUIT 

               Begin DoDot:1

 +10               IF $DATA(^ACRLOCB(ACR,"SC",ACRDA,0))

                       IF '$DATA(ACREX(+^(0)))

                           Begin DoDot:2

 +11                           SET DA(1)=ACR

 +12                           SET DA=ACRDA

 +13                           SET DIK="^ACRLOCB("_ACR_",""SC"","

                               WRITE "."

 +14                           DO DIK^ACRFDIC

                           End DoDot:2

               End DoDot:1

 +15       QUIT 

EX        ;CHOOSE USER(S) TO EXCLUDE FROM ACCOUNT ACCESS DELETE

 +1       ;SELECT 'EMPLOYEE'

 +2        WRITE !!,"You may identify employees for whom access will NOT be deleted."

 +3        WRITE !,"The employees selected below will NOT have their account access deleted."

 +4        FOR 

               DO EX1

               IF $DATA(ACRQUIT)

                   QUIT 

 +5        QUIT 

EX1       ;CHOOSE EMPLOYEE

 +1        SET DIC="^VA(200,"

 +2        SET DIC(0)="AEMQZ"

 +3        SET DIC("A")="EMPLOYEE............: "

 +4        SET DIC("DR")=""

 +5        WRITE !!?21,"|"

           FOR ACRI=1:1:30

               WRITE "="

 +6        WRITE "|"

 +7        DO DIC^ACRFDIC

 +8        IF U[$EXTRACT(X)!(+Y<1)

               SET ACRQUIT=""

               QUIT 

 +9        SET ACRDUZ=+Y

 +10       SET ACREX(+Y)=""

 +11      ;S ACRUSER=Y(0,0)  ;ACR*2.1*19.02 IM16848

 +12      ;S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",")  ;ACR*2.1*19.02 IM16848

 +13      ;ACR*2.1*19.02 IM16848

           SET ACRUSER=$$NAME3^ACRFUTL1(ACRDUZ)

 +14       WRITE !!,ACRUSER," will NOT be deleted from account access."

 +15       QUIT 

SELECT    ;SELECT SINGLE DEPARTMENT ACCOUNT FROM WHICH TO DELETE ACCESS

 +1        SET DIC="^ACRLOCB("

 +2        SET DIC(0)="AENQZ"

 +3        SET DIC("A")="Account ID NO.: "

 +4        SET DIC("?")="Enter the ID NO. of the account from which to delete access."

 +5        WRITE !

 +6        DO DIC^ACRFDIC

 +7        IF +Y<1

               QUIT 

 +8        IF $DATA(^ACRLOCB(+Y,0))

               Begin DoDot:1

 +9                SET ACR=+Y

                   SET ACR0=^ACRLOCB(+Y,0)

                   SET ACRDT=^ACRLOCB(+Y,"DT")

 +10               DO CERTAIN

 +11               IF $DATA(ACRQUIT)

                       QUIT 

 +12               DO DELETE

               End DoDot:1

 +13       QUIT 

CERTAIN   ;CHECK TO ENSURE USER WANST TO DELETE ACCOUNT ACCESS

 +1        SET DIR(0)="YO"

 +2        SET DIR("A")="Are you CERTAIN you want to delete account access"

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

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        IF Y'=1

               SET ACRQUIT=""

 +7        QUIT