ACRFONE.m

ACRFONE ;IHS/OIRM/DSD/THL,AEF - CHECK FOR MULTIPLE DEPARTMENT ACCOUNTS FOR USER; [ 11/01/2001   9:44 AM ]

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

 ;;ROUTINE TO CHECK IF USER HAD ACCESS TO MULTIPLE DEPARTMENT ACCOUNTS

EN D EN1

EXIT K ACRJ,ACRX

 Q

EN1 D EN11

 I ACRJ>1 K ACRONE Q

 I ACRJ=1 D  Q

 .S (DA,ACRZDA,ACRFDNO)=ACRONE

 .S ACRFDNA=$P(^ACRLOCB(ACRONE,0),U)

 .S ACRCANDA=$P(^ACRLOCB(ACRONE,"DT"),U,9)

 .S ACRGREF=$P($P(ACRDATA1,";;",3),"(")

 .S ACRY=$P(ACRDATA1,";;",2)

 .D EN^ACRFDTP2

 W !!,*7,"You have not been given access to any accounts."

 W !,"You must have access to at least one account to do data entry."

 W !,"Ask your systems operator for assistance."

 D PAUSE^ACRFWARN

 S ACRQUIT=""

 Q

EN11 S (ACRX,ACRJ)=0

 F  S ACRX=$O(^ACRLOCB("SEC",DUZ,ACRX)) Q:'ACRX!(ACRJ>1)!$D(ACRQUIT)!$D(ACROUT)  D:$D(^ACRLOCB(ACRX,0))

 .S:$P(^ACRLOCB(ACRX,0),U,8)="O" ACRJ=ACRJ+1

 .S ACRONE=ACRX

 Q

ACRFONE   ;IHS/OIRM/DSD/THL,AEF - CHECK FOR MULTIPLE DEPARTMENT ACCOUNTS FOR USER; [ 11/01/2001   9:44 AM ]

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

 +2       ;;ROUTINE TO CHECK IF USER HAD ACCESS TO MULTIPLE DEPARTMENT ACCOUNTS

EN         DO EN1

EXIT       KILL ACRJ,ACRX

 +1        QUIT 

EN1        DO EN11

 +1        IF ACRJ>1

               KILL ACRONE

               QUIT 

 +2        IF ACRJ=1

               Begin DoDot:1

 +3                SET (DA,ACRZDA,ACRFDNO)=ACRONE

 +4                SET ACRFDNA=$PIECE(^ACRLOCB(ACRONE,0),U)

 +5                SET ACRCANDA=$PIECE(^ACRLOCB(ACRONE,"DT"),U,9)

 +6                SET ACRGREF=$PIECE($PIECE(ACRDATA1,";;",3),"(")

 +7                SET ACRY=$PIECE(ACRDATA1,";;",2)

 +8                DO EN^ACRFDTP2

               End DoDot:1

               QUIT 

 +9        WRITE !!,*7,"You have not been given access to any accounts."

 +10       WRITE !,"You must have access to at least one account to do data entry."

 +11       WRITE !,"Ask your systems operator for assistance."

 +12       DO PAUSE^ACRFWARN

 +13       SET ACRQUIT=""

 +14       QUIT 

EN11       SET (ACRX,ACRJ)=0

 +1        FOR 

               SET ACRX=$ORDER(^ACRLOCB("SEC",DUZ,ACRX))

               IF 'ACRX!(ACRJ>1)!$DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

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

                   Begin DoDot:1

 +2                    IF $PIECE(^ACRLOCB(ACRX,0),U,8)="O"

                           SET ACRJ=ACRJ+1

 +3                    SET ACRONE=ACRX

                   End DoDot:1

 +4        QUIT