- ACRFAU ;IHS/OIRM/DSD/THL,AEF - EDIT ARMS USER INFORMATION; [ 10/26/2006 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,21**;NOV 05, 2001
- ;;ROUTINE USED TO EDIT ARMS USER INFORMATION
- AU ;EP;TO ENTER/UPDATE ARMS USER DATA
- D 10
- Q:$D(ACRQUIT)
- F D AU1 Q:$D(ACRQUIT)!$D(ACROUT)
- K ACRQUIT
- Q
- AU1 ;SELECT EMPLOYEE
- D EMPLOYEE
- I '$G(ACRDUZ) S ACRQUIT="" Q
- I '$D(^ACRAU("B",ACRDUZ))!'$D(^ACRAU(ACRDUZ,0)) D
- .I '$D(^ACRAU(ACRDUZ,0)) D
- ..S (X,DINUM)=ACRDUZ
- ..S DIC="^ACRAU("
- ..S DIC(0)="L"
- ..D FILE^ACRFDIC
- .I +$G(^ACRAU(ACRDUZ,0))'=ACRDUZ D
- ..S DA=ACRDUZ
- ..S DIE="^ACRAU("
- ..S DR=".01///"_ACRDUZ
- ..D DIE^ACRFDIC
- .I +$G(^ACRAU(ACRDUZ,0))'=ACRDUZ S $P(^ACRAU(ACRDUZ,0),U)=ACRDUZ
- .I '$D(^ACRAU("B",ACRDUZ))#2 S ^ACRAU("B",ACRDUZ,ACRDUZ)=""
- D SETREQ^ACRFDRC1
- K ACRNWLVL
- S ACRLVLDA=1
- I '$D(^ACRUAL(ACRDUZ,0)) D
- .D ACCESS^ACRFACC
- .S ACRLVLDA=1
- .D SETKILL^ACRFACC
- S ACRDA=ACRDUZ
- Q:'ACRDA
- F D AU2 Q:$D(ACRQUIT)!$D(ACROUT)
- K ACRQUIT
- Q
- AU2 W @IOF
- W !?10,"Edit ARMS USER DATA for ",ACRUSER
- W !!?5,"Select USER EDIT FUNCTION"
- W !!?10,1
- W ?15,"Print User Profile"
- W !?10,2
- W ?15,"Edit Basic Data"
- W !?10,3
- W ?15,"Edit Signature Authorities"
- W !?10,4
- W ?15,"Edit Access Level"
- W !?10,5
- W ?15,"Delete User's ARMS Access"
- W !?10,6
- W ?15,"Assign/Delete Access to Multiple Department Accounts"
- W !?10,7
- W ?15,"Assign Access to Multiple Blanket Purchase Agreements"
- S DIR(0)="LO^1:7"
- S DIR("A")="Which one"
- W !
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)!'+ACRY
- S ACRAU=ACRY
- F ACRAUJ=1:1 S ACRAUX=$P(ACRAU,",",ACRAUJ) Q:'ACRAUX!$D(ACROUT) D
- .S ACRAUX=$S(ACRAUX=1:"PSUM",ACRAUX=2:"BASIC",ACRAUX=3:"AUTHOR",ACRAUX=4:"ACCESS",ACRAUX=5:"DELETE",ACRAUX=6:"MCAN",ACRAUX=7:"BPA^ACRFACC")
- .W !
- .D @ACRAUX
- .K ACRQUIT
- K ACRAU,ACRAUJ,ACRAUX
- Q
- PSUM ;EP;TO DISPLAY ARMS USER DATA
- S ZTDESC="ARMS USER DATA SUMMARY"
- S ACRRTN="PS1^ACRFUP"
- D ^ACRFZIS
- Q
- MP ;EP;TO ALLOW USER TO EDIT THEIR OWN USER DATA
- S ACRDA=DUZ
- S DR="[ACR MY PERSON PROFILE]"
- S ACRDR="[ACR MY PROFILE]"
- BASIC ;EDIT BASIC ARMS USER DATA FROM THE PERSON AND EMPLOYEE FILES
- Q:'$G(ACRDA)
- S DA=ACRDA
- S DIE="^VA(200,"
- S DR=$S('$D(DR):"[ACR PERSON]",1:DR)
- D DDS^ACRFDIC
- I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
- I '$D(^ACRAU(ACRDA,0))#2 D
- .S (X,DINUM)=ACRDA,DIC="^ACRAU(",DIC(0)="L"
- .D FILE^ACRFDIC
- S DA=ACRDA
- S DIE="^ACRAU("
- S DR=$S('$D(ACRDR):"[ACR ARMS USER]",1:ACRDR)
- D DDS^ACRFDIC
- I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
- W !
- Q
- AUTHOR D EN^ACRFDRC1
- Q
- ACCESS D EN2^ACRFACC
- Q
- DELETE D DELETE^ACRFACC
- Q
- MCAN ;EP;TO ASSIGN MULTIPLE CANS TO ARMS USER
- K ACRDEL
- S DIR(0)="SO^1:Assign Access;2:Delete Access"
- S DIR("A")="Which one"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)!(+Y<1)
- I Y=2 S ACRDEL=""
- S DIR(0)="SO^1:Appropriation Accounts;2:Allowance Accounts;3:Sub-Allowance Accounts;4:Department Accounts"
- S DIR("A")="Which one"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)!(+Y<1)
- S ACRDIC=$S(Y=1:"^ACRAPP",Y=2:"^ACRALW",Y=3:"^ACRALC",1:"^ACRLOCB")
- S DIR(0)="LO^1:"_$P(@ACRDIC@(0),U,3)
- S DIR("A")="List ID NO(s). of the Accounts"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)!(+Y<1)
- N ACRYY
- S %X="Y("
- S %Y="ACRYY("
- D %XY^%RCR
- K Y
- S ACRYY=ACRYY(0)
- D:'$D(ACRDEL) MCAN1
- D:$D(ACRDEL) DCAN1
- I $D(ACRYY(1)) D
- .S ACRJ=0
- .F S ACRJ=$O(ACRYY(ACRJ)) Q:'ACRJ D
- ..S ACRYY=ACRYY(ACRJ)
- ..D:'$D(ACRDEL) MCAN1
- ..D:$D(ACRDEL) DCAN1
- K ACRDEL
- Q
- MCAN1 F ACRI=1:1 S ACRX=$P(ACRYY,",",ACRI) Q:ACRX="" I $D(@ACRDIC@(ACRX,0))#2 D
- .S:'$D(@ACRDIC@(ACRX,"SC",0)) @ACRDIC@(ACRX,"SC",0)=$S(ACRDIC["ACRALW":"^9002186.01P",ACRDIC["ACRALC":"^9002187.04P",1:"^9002188.04P")
- .Q:$D(@ACRDIC@(ACRX,"SC","B",ACRDUZ))
- .S DA(1)=ACRX
- .S DIC=ACRDIC_"("_ACRX_",""SC"","
- .S DIC(0)="L",X=ACRDUZ
- .D FILE^ACRFDIC
- Q
- DCAN1 F ACRI=1:1 S ACRX=$P(ACRYY,",",ACRI) Q:ACRX="" I $D(@ACRDIC@(ACRX)) D
- .S DA(1)=ACRX
- .S DA=$O(@ACRDIC@(ACRX,"SC","B",ACRDUZ,0))
- .S DIK=ACRDIC_"("_ACRX_",""SC"","
- .D:DA DIK^ACRFDIC
- Q
- 10 ;EP;TO LIST USERS WITH ACCESS LEVEL 10
- Q:'$D(^ACRUAL("LVL",DUZ,3))
- N X,Y
- W @IOF
- W !?10,"LIST OF USERS WITH LEVEL 9 OR 10 ACCESS"
- W !?10,"---------------------------------------"
- S X=0
- F S X=$O(^ACRUAL("LVL",X)) Q:'X D
- .;I $D(^ACRUAL("LVL",X,3))!$D(^ACRUAL("LVL",X,11)),$D(^VA(200,X,0)) S Y=$P(^(0),U) D ;ACR*2.1*19.02 IM16848
- .I $D(^ACRUAL("LVL",X,3))!$D(^ACRUAL("LVL",X,11)),$D(^VA(200,X,0)) S Y=$$NAME2^ACRFUTL1(X) D ;ACR*2.1*19.02 IM16848
- ..S Y=$P($P(Y,",",2)," ")_" "_$P(Y,",")
- ..W !?10,Y,?32,"LEVEL ",$S($O(^ACRUAL("LVL",X,0))=3:10,1:9)
- W !!!,"The users listed above all have LEVEL 9 or 10 access to ARMS."
- W !!,"Only users who absolutely need this level of access and who are performing"
- W !,"ARMS Manager functions should have LEVEL 9 or 10 access."
- W !!,"Review this information to ensure that only authorized ARMS Managers"
- W !,"have LEVEL 9 or 10 access."
- D PAUSE^ACRFWARN
- Q
- SCREEN ;EP;TO DETERMINE IF SCREENMAN SHOULD BE INVOKED
- K ACRSCREN
- I +$G(^ACRSYS(1,"DT1")) S ACRSCREN="" Q
- I $P($G(^ACRSYS(1,"DT")),U,40),$P($G(^ACRAU(DUZ,1)),U,13) S ACRSCREN=""
- Q
- LIST ;EP;TO PRINT LIST OF ARMS USERS
- S DIC="^ACRAU("
- S FLDS="[ACR ARMS USER LIST]"
- S BY=".01"
- S FR="A"
- S TO="ZZ"
- S IOP=ION
- D EN1^DIP
- D PAUSE^ACRFWARN
- Q
- PLIST ;EP;TO DISPLAY LIST OF ARMS USERS
- S ZTDESC="ARMS USER LIST"
- S ACRRTN="LIST^ACRFAU"
- D ^ACRFZIS
- Q
- EMPLOYEE ;EP;TO SELECT EMPLOYEE
- W @IOF
- EMP1 ;EP;TO SKIP FORM FEED
- K ACRDUZ
- 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 ACRUSER=Y(0,0) ;ACR*2.1*21.02 IM16848
- ;S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",") ;ACR*2.1*21.02 IM16848
- S ACRUSER=$$NAME3^ACRFUTL1(ACRDUZ) ;ACR*2.1*21.02 IM16848
- Q
- FDMCAN ;EP;ASSIGN ACCESS TO MULTIPLE ACCOUNTS FROM FUNDS DISTRIBUTION
- K ACRDUZ
- D EMPLOYEE
- I '$G(ACRDUZ) S ACRQUIT="" Q
- D MCAN
- Q
- ACRFAU ;IHS/OIRM/DSD/THL,AEF - EDIT ARMS USER INFORMATION; [ 10/26/2006 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,21**;NOV 05, 2001
- +2 ;;ROUTINE USED TO EDIT ARMS USER INFORMATION
- AU ;EP;TO ENTER/UPDATE ARMS USER DATA
- +1 DO 10
- +2 IF $DATA(ACRQUIT)
- QUIT
- +3 FOR
- DO AU1
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +4 KILL ACRQUIT
- +5 QUIT
- AU1 ;SELECT EMPLOYEE
- +1 DO EMPLOYEE
- +2 IF '$GET(ACRDUZ)
- SET ACRQUIT=""
- QUIT
- +3 IF '$DATA(^ACRAU("B",ACRDUZ))!'$DATA(^ACRAU(ACRDUZ,0))
- Begin DoDot:1
- +4 IF '$DATA(^ACRAU(ACRDUZ,0))
- Begin DoDot:2
- +5 SET (X,DINUM)=ACRDUZ
- +6 SET DIC="^ACRAU("
- +7 SET DIC(0)="L"
- +8 DO FILE^ACRFDIC
- End DoDot:2
- +9 IF +$GET(^ACRAU(ACRDUZ,0))'=ACRDUZ
- Begin DoDot:2
- +10 SET DA=ACRDUZ
- +11 SET DIE="^ACRAU("
- +12 SET DR=".01///"_ACRDUZ
- +13 DO DIE^ACRFDIC
- End DoDot:2
- +14 IF +$GET(^ACRAU(ACRDUZ,0))'=ACRDUZ
- SET $PIECE(^ACRAU(ACRDUZ,0),U)=ACRDUZ
- +15 IF '$DATA(^ACRAU("B",ACRDUZ))#2
- SET ^ACRAU("B",ACRDUZ,ACRDUZ)=""
- End DoDot:1
- +16 DO SETREQ^ACRFDRC1
- +17 KILL ACRNWLVL
- +18 SET ACRLVLDA=1
- +19 IF '$DATA(^ACRUAL(ACRDUZ,0))
- Begin DoDot:1
- +20 DO ACCESS^ACRFACC
- +21 SET ACRLVLDA=1
- +22 DO SETKILL^ACRFACC
- End DoDot:1
- +23 SET ACRDA=ACRDUZ
- +24 IF 'ACRDA
- QUIT
- +25 FOR
- DO AU2
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +26 KILL ACRQUIT
- +27 QUIT
- AU2 WRITE @IOF
- +1 WRITE !?10,"Edit ARMS USER DATA for ",ACRUSER
- +2 WRITE !!?5,"Select USER EDIT FUNCTION"
- +3 WRITE !!?10,1
- +4 WRITE ?15,"Print User Profile"
- +5 WRITE !?10,2
- +6 WRITE ?15,"Edit Basic Data"
- +7 WRITE !?10,3
- +8 WRITE ?15,"Edit Signature Authorities"
- +9 WRITE !?10,4
- +10 WRITE ?15,"Edit Access Level"
- +11 WRITE !?10,5
- +12 WRITE ?15,"Delete User's ARMS Access"
- +13 WRITE !?10,6
- +14 WRITE ?15,"Assign/Delete Access to Multiple Department Accounts"
- +15 WRITE !?10,7
- +16 WRITE ?15,"Assign Access to Multiple Blanket Purchase Agreements"
- +17 SET DIR(0)="LO^1:7"
- +18 SET DIR("A")="Which one"
- +19 WRITE !
- +20 DO DIR^ACRFDIC
- +21 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'+ACRY
- QUIT
- +22 SET ACRAU=ACRY
- +23 FOR ACRAUJ=1:1
- SET ACRAUX=$PIECE(ACRAU,",",ACRAUJ)
- IF 'ACRAUX!$DATA(ACROUT)
- QUIT
- Begin DoDot:1
- +24 SET ACRAUX=$SELECT(ACRAUX=1:"PSUM",ACRAUX=2:"BASIC",ACRAUX=3:"AUTHOR",ACRAUX=4:"ACCESS",ACRAUX=5:"DELETE",ACRAUX=6:"MCAN",ACRAUX=7:"BPA^ACRFACC")
- +25 WRITE !
- +26 DO @ACRAUX
- +27 KILL ACRQUIT
- End DoDot:1
- +28 KILL ACRAU,ACRAUJ,ACRAUX
- +29 QUIT
- PSUM ;EP;TO DISPLAY ARMS USER DATA
- +1 SET ZTDESC="ARMS USER DATA SUMMARY"
- +2 SET ACRRTN="PS1^ACRFUP"
- +3 DO ^ACRFZIS
- +4 QUIT
- MP ;EP;TO ALLOW USER TO EDIT THEIR OWN USER DATA
- +1 SET ACRDA=DUZ
- +2 SET DR="[ACR MY PERSON PROFILE]"
- +3 SET ACRDR="[ACR MY PROFILE]"
- BASIC ;EDIT BASIC ARMS USER DATA FROM THE PERSON AND EMPLOYEE FILES
- +1 IF '$GET(ACRDA)
- QUIT
- +2 SET DA=ACRDA
- +3 SET DIE="^VA(200,"
- +4 SET DR=$SELECT('$DATA(DR):"[ACR PERSON]",1:DR)
- +5 DO DDS^ACRFDIC
- +6 IF $DATA(ACRSCREN)
- KILL ACRSCREN
- DO DIE^ACRFDIC
- +7 IF '$DATA(^ACRAU(ACRDA,0))#2
- Begin DoDot:1
- +8 SET (X,DINUM)=ACRDA
- SET DIC="^ACRAU("
- SET DIC(0)="L"
- +9 DO FILE^ACRFDIC
- End DoDot:1
- +10 SET DA=ACRDA
- +11 SET DIE="^ACRAU("
- +12 SET DR=$SELECT('$DATA(ACRDR):"[ACR ARMS USER]",1:ACRDR)
- +13 DO DDS^ACRFDIC
- +14 IF $DATA(ACRSCREN)
- KILL ACRSCREN
- DO DIE^ACRFDIC
- +15 WRITE !
- +16 QUIT
- AUTHOR DO EN^ACRFDRC1
- +1 QUIT
- ACCESS DO EN2^ACRFACC
- +1 QUIT
- DELETE DO DELETE^ACRFACC
- +1 QUIT
- MCAN ;EP;TO ASSIGN MULTIPLE CANS TO ARMS USER
- +1 KILL ACRDEL
- +2 SET DIR(0)="SO^1:Assign Access;2:Delete Access"
- +3 SET DIR("A")="Which one"
- +4 DO DIR^ACRFDIC
- +5 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+Y<1)
- QUIT
- +6 IF Y=2
- SET ACRDEL=""
- +7 SET DIR(0)="SO^1:Appropriation Accounts;2:Allowance Accounts;3:Sub-Allowance Accounts;4:Department Accounts"
- +8 SET DIR("A")="Which one"
- +9 DO DIR^ACRFDIC
- +10 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+Y<1)
- QUIT
- +11 SET ACRDIC=$SELECT(Y=1:"^ACRAPP",Y=2:"^ACRALW",Y=3:"^ACRALC",1:"^ACRLOCB")
- +12 SET DIR(0)="LO^1:"_$PIECE(@ACRDIC@(0),U,3)
- +13 SET DIR("A")="List ID NO(s). of the Accounts"
- +14 DO DIR^ACRFDIC
- +15 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+Y<1)
- QUIT
- +16 NEW ACRYY
- +17 SET %X="Y("
- +18 SET %Y="ACRYY("
- +19 DO %XY^%RCR
- +20 KILL Y
- +21 SET ACRYY=ACRYY(0)
- +22 IF '$DATA(ACRDEL)
- DO MCAN1
- +23 IF $DATA(ACRDEL)
- DO DCAN1
- +24 IF $DATA(ACRYY(1))
- Begin DoDot:1
- +25 SET ACRJ=0
- +26 FOR
- SET ACRJ=$ORDER(ACRYY(ACRJ))
- IF 'ACRJ
- QUIT
- Begin DoDot:2
- +27 SET ACRYY=ACRYY(ACRJ)
- +28 IF '$DATA(ACRDEL)
- DO MCAN1
- +29 IF $DATA(ACRDEL)
- DO DCAN1
- End DoDot:2
- End DoDot:1
- +30 KILL ACRDEL
- +31 QUIT
- MCAN1 FOR ACRI=1:1
- SET ACRX=$PIECE(ACRYY,",",ACRI)
- IF ACRX=""
- QUIT
- IF $DATA(@ACRDIC@(ACRX,0))#2
- Begin DoDot:1
- +1 IF '$DATA(@ACRDIC@(ACRX,"SC",0))
- SET @ACRDIC@(ACRX,"SC",0)=$SELECT(ACRDIC["ACRALW":"^9002186.01P",ACRDIC["ACRALC":"^9002187.04P",1:"^9002188.04P")
- +2 IF $DATA(@ACRDIC@(ACRX,"SC","B",ACRDUZ))
- QUIT
- +3 SET DA(1)=ACRX
- +4 SET DIC=ACRDIC_"("_ACRX_",""SC"","
- +5 SET DIC(0)="L"
- SET X=ACRDUZ
- +6 DO FILE^ACRFDIC
- End DoDot:1
- +7 QUIT
- DCAN1 FOR ACRI=1:1
- SET ACRX=$PIECE(ACRYY,",",ACRI)
- IF ACRX=""
- QUIT
- IF $DATA(@ACRDIC@(ACRX))
- Begin DoDot:1
- +1 SET DA(1)=ACRX
- +2 SET DA=$ORDER(@ACRDIC@(ACRX,"SC","B",ACRDUZ,0))
- +3 SET DIK=ACRDIC_"("_ACRX_",""SC"","
- +4 IF DA
- DO DIK^ACRFDIC
- End DoDot:1
- +5 QUIT
- 10 ;EP;TO LIST USERS WITH ACCESS LEVEL 10
- +1 IF '$DATA(^ACRUAL("LVL",DUZ,3))
- QUIT
- +2 NEW X,Y
- +3 WRITE @IOF
- +4 WRITE !?10,"LIST OF USERS WITH LEVEL 9 OR 10 ACCESS"
- +5 WRITE !?10,"---------------------------------------"
- +6 SET X=0
- +7 FOR
- SET X=$ORDER(^ACRUAL("LVL",X))
- IF 'X
- QUIT
- Begin DoDot:1
- +8 ;I $D(^ACRUAL("LVL",X,3))!$D(^ACRUAL("LVL",X,11)),$D(^VA(200,X,0)) S Y=$P(^(0),U) D ;ACR*2.1*19.02 IM16848
- +9 ;ACR*2.1*19.02 IM16848
- IF $DATA(^ACRUAL("LVL",X,3))!$DATA(^ACRUAL("LVL",X,11))
- IF $DATA(^VA(200,X,0))
- SET Y=$$NAME2^ACRFUTL1(X)
- Begin DoDot:2
- +10 SET Y=$PIECE($PIECE(Y,",",2)," ")_" "_$PIECE(Y,",")
- +11 WRITE !?10,Y,?32,"LEVEL ",$SELECT($ORDER(^ACRUAL("LVL",X,0))=3:10,1:9)
- End DoDot:2
- End DoDot:1
- +12 WRITE !!!,"The users listed above all have LEVEL 9 or 10 access to ARMS."
- +13 WRITE !!,"Only users who absolutely need this level of access and who are performing"
- +14 WRITE !,"ARMS Manager functions should have LEVEL 9 or 10 access."
- +15 WRITE !!,"Review this information to ensure that only authorized ARMS Managers"
- +16 WRITE !,"have LEVEL 9 or 10 access."
- +17 DO PAUSE^ACRFWARN
- +18 QUIT
- SCREEN ;EP;TO DETERMINE IF SCREENMAN SHOULD BE INVOKED
- +1 KILL ACRSCREN
- +2 IF +$GET(^ACRSYS(1,"DT1"))
- SET ACRSCREN=""
- QUIT
- +3 IF $PIECE($GET(^ACRSYS(1,"DT")),U,40)
- IF $PIECE($GET(^ACRAU(DUZ,1)),U,13)
- SET ACRSCREN=""
- +4 QUIT
- LIST ;EP;TO PRINT LIST OF ARMS USERS
- +1 SET DIC="^ACRAU("
- +2 SET FLDS="[ACR ARMS USER LIST]"
- +3 SET BY=".01"
- +4 SET FR="A"
- +5 SET TO="ZZ"
- +6 SET IOP=ION
- +7 DO EN1^DIP
- +8 DO PAUSE^ACRFWARN
- +9 QUIT
- PLIST ;EP;TO DISPLAY LIST OF ARMS USERS
- +1 SET ZTDESC="ARMS USER LIST"
- +2 SET ACRRTN="LIST^ACRFAU"
- +3 DO ^ACRFZIS
- +4 QUIT
- EMPLOYEE ;EP;TO SELECT EMPLOYEE
- +1 WRITE @IOF
- EMP1 ;EP;TO SKIP FORM FEED
- +1 KILL ACRDUZ
- +2 SET DIC="^VA(200,"
- +3 SET DIC(0)="AEMQZ"
- +4 SET DIC("A")="EMPLOYEE............: "
- +5 SET DIC("DR")=""
- +6 WRITE !!?21,"|"
- FOR ACRI=1:1:30
- WRITE "="
- +7 WRITE "|"
- +8 DO DIC^ACRFDIC
- +9 IF U[$EXTRACT(X)!(+Y<1)
- SET ACRQUIT=""
- QUIT
- +10 SET ACRDUZ=+Y
- +11 ;S ACRUSER=Y(0,0) ;ACR*2.1*21.02 IM16848
- +12 ;S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",") ;ACR*2.1*21.02 IM16848
- +13 ;ACR*2.1*21.02 IM16848
- SET ACRUSER=$$NAME3^ACRFUTL1(ACRDUZ)
- +14 QUIT
- FDMCAN ;EP;ASSIGN ACCESS TO MULTIPLE ACCOUNTS FROM FUNDS DISTRIBUTION
- +1 KILL ACRDUZ
- +2 DO EMPLOYEE
- +3 IF '$GET(ACRDUZ)
- SET ACRQUIT=""
- QUIT
- +4 DO MCAN
- +5 QUIT