- 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