Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFAU

ACRFAU.m

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