ACRFDRC1 ;IHS/OIRM/DSD/THL,AEF - USER APPROVAL AUTHORITY; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO EDIT USER APPROVAL AUTHORITY
EN ;EP;
F D EN1 Q:'$D(ACRDUZ)!$D(ACROUT)!$D(ACRQUIT)!$D(ACROUT)
EXIT K ACRDATA,ACRQUIT,ACRSET,ACRJ,ACRJ2,ACRMAX,J
Q
EN1 W @IOF
W !?22,"ESTABLISH USER SIGNATURE AUTHORITY"
W !?22,"=================================="
W !
W !?5,"Select Authority Categories:"
W !!?10,"1"
W ?15,"ACQUISITION"
W !?10,"2"
W ?15,"TRAVEL"
W !?10,"3"
W ?15,"TRAINING"
W !?10,"4"
W ?15,"PURCHASE ORDER"
W !?10,"5"
W ?15,"RECEIVING"
W !?10,"6"
W ?15,"FMO"
W !?10,"7"
W ?15,"TRAVEL VOUCHER"
S DIR(0)="LO^1:7"
S DIR("A")="Which one(S)"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
S ACRCATX=ACRY
F J=1:1 S ACRCAT=$P(ACRCATX,",",J) Q:ACRCAT="" D DISPLAY Q:$D(ACROUT)
K ACRQUIT
Q
DISPLAY F D D1 Q:$D(ACROUT)!$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
D1 K DR,ACRDR,ACRZ
W @IOF
W ?10,@ACRON,$P($P($P(^DD(9002190.5,.06,0),U,3),ACRCAT_":",2),";"),@ACROF
W " Authorities for: ",@ACRON,ACRUSER,@ACROF
W !!?10,"NO."
W ?15,"APPROVAL CATEGORY"
W !?10,"--- ---------------------------"
S (ACRJ,ACRAPDA)=0
F S ACRAPDA=$O(^ACRAPVT("C",ACRCAT,ACRAPDA)) Q:'ACRAPDA D
.S ACRJ=ACRJ+1
.D DISP1
S ACRMAX=ACRJ
F ACRJ=1:1:ACRMAX D
.W !?10,$J(ACRJ,2)_") ",$P(ACRZ(ACRJ),U,3)
.W ?44,$S($P(ACRZ(ACRJ),U,2)=1:"<==",1:"")
.D:ACRJ=10 PAUSE^ACRFWARN
K ACRAPDA
D:'$D(ACROUT) SELECT
Q
DISP1 S ACRZ=^ACRAPVT(ACRAPDA,0)
S ACRNAM=$P(ACRZ,U)
S ACRORDR=$P(ACRZ,U,4)
S ACRI=$S($D(^ACRAPL("AC",ACRDUZ,ACRAPDA)):1,1:0)
S ACRZ(ACRORDR)=ACRAPDA_U_ACRI_U_$E(ACRNAM,1,28)
K ACRNAM,ACRORDR
Q
DISP2 S ACRJ2=ACRJ+ACRMAX
W !?2,$J(ACRJ,2),") ",$P(ACRZ(ACRJ),U,3)
W ?34,$S($P(ACRZ(ACRJ),U,2)=1:"<==",1:"")
I $D(ACRZ(ACRJ2)) D
.W ?42,$J(ACRJ2,2)_") ",$P(ACRZ(ACRJ2),U,3)
.W ?74,$S($P(ACRZ(ACRJ2),U,2)=1:"<==",1:"")
Q
SELECT W !!?10,"'<==' indicates user has this signature authority."
W !
S DIR(0)="SOA^A:Add APPROVAL AUTHORITIES;D:Delete APPROVAL AUTHORITIES;O:Exit APPROVAL Edit Sequence"
S DIR("A")=" (A)dd/(D)elete/(O)UT: "
D DIR^ACRFDIC
I Y="O" S ACROUT="" Q
Q:$D(ACRQUIT)!$D(ACROUT)
K ACRDR
S:Y="D" ACRDR=".01///@"
S DIR(0)="LO^1:"_ACRMAX
S DIR("A")=" Which AUTHORITY(IES)"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
S ACRQK=Y(0)
D LOOP Q
Q
LOOP S ACRQK1=ACRQK
W !
F ACRLI=1:1 S ACRQK=$P(ACRQK1,",",ACRLI) Q:'ACRQK!$D(ACRQUIT)!$D(ACROUT) Q:'$D(ACRZ(ACRQK)) D SET2
K ACRCNT
Q
SET2 S ACRAPDA=$P(ACRZ(ACRQK),U)
S ACRAP=$P(^ACRAPVT(ACRAPDA,0),U)
S X=ACRDUZ
S (DIE,DIC)="^ACRAPL("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRAPDA
I '$D(ACRDR) D Q
.D:'$D(^ACRAPL("AC",ACRDUZ,ACRAPDA)) FILE^ACRFDIC
.I ACRAPDA=21,'$D(^ACRAPL("AC",ACRDUZ,37)) D
..S X=ACRDUZ
..S DIC="^ACRAPL("
..S DIC(0)="L"
..S DIC("DR")=".02////37"
..D FILE^ACRFDIC
.I ACRAPDA=8,'$D(^ACRAPL("AC",ACRDUZ,45)) D
..S X=ACRDUZ
..S DIC="^ACRAPL("
..S DIC(0)="L"
..S DIC("DR")=".02////45"
..D FILE^ACRFDIC
.W !!,"Alternates for......: ",@ACRON,ACRUSER,@ACROF
.W !,"when signing as the.: ",@ACRON,ACRAP,@ACROF
.S DA=$O(^ACRAPL("AC",ACRDUZ,ACRAPDA,0))
.S DIE="^ACRAPL("
.S DR="[ACR APPROVAL ALTERNATE]"
.D:DA DDS^ACRFDIC
.I $D(ACRSCREN) K ACRSCREN D:DA DIE^ACRFDIC
S DR=ACRDR
S DA=$O(^ACRAPL("AC",ACRDUZ,ACRAPDA,0))
D:DA DIE^ACRFDIC
Q
SETREQ ;EP;TO AUTOMATICALLY SET APPROVAL AUTHORITY FOR REQUEST INITIATOR,
;;TRAVEL REQUESTED BY AND TRAVELER FOR EVERY ARMS USER
F ACRAPDA=32,36,40,41 I '$D(^ACRAPL("AC",ACRDUZ,ACRAPDA)) D
.S X=ACRDUZ
.S DIC="^ACRAPL("
.S DIC(0)="L"
.S DIC("DR")=".02////"_ACRAPDA
.D FILE^ACRFDIC
Q
ACRFDRC1 ;IHS/OIRM/DSD/THL,AEF - USER APPROVAL AUTHORITY; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO EDIT USER APPROVAL AUTHORITY
EN ;EP;
+1 FOR
DO EN1
IF '$DATA(ACRDUZ)!$DATA(ACROUT)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACRDATA,ACRQUIT,ACRSET,ACRJ,ACRJ2,ACRMAX,J
+1 QUIT
EN1 WRITE @IOF
+1 WRITE !?22,"ESTABLISH USER SIGNATURE AUTHORITY"
+2 WRITE !?22,"=================================="
+3 WRITE !
+4 WRITE !?5,"Select Authority Categories:"
+5 WRITE !!?10,"1"
+6 WRITE ?15,"ACQUISITION"
+7 WRITE !?10,"2"
+8 WRITE ?15,"TRAVEL"
+9 WRITE !?10,"3"
+10 WRITE ?15,"TRAINING"
+11 WRITE !?10,"4"
+12 WRITE ?15,"PURCHASE ORDER"
+13 WRITE !?10,"5"
+14 WRITE ?15,"RECEIVING"
+15 WRITE !?10,"6"
+16 WRITE ?15,"FMO"
+17 WRITE !?10,"7"
+18 WRITE ?15,"TRAVEL VOUCHER"
+19 SET DIR(0)="LO^1:7"
+20 SET DIR("A")="Which one(S)"
+21 WRITE !
+22 DO DIR^ACRFDIC
+23 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+24 SET ACRCATX=ACRY
+25 FOR J=1:1
SET ACRCAT=$PIECE(ACRCATX,",",J)
IF ACRCAT=""
QUIT
DO DISPLAY
IF $DATA(ACROUT)
QUIT
+26 KILL ACRQUIT
+27 QUIT
DISPLAY FOR
DO D1
IF $DATA(ACROUT)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 KILL ACRQUIT
+2 QUIT
D1 KILL DR,ACRDR,ACRZ
+1 WRITE @IOF
+2 WRITE ?10,@ACRON,$PIECE($PIECE($PIECE(^DD(9002190.5,.06,0),U,3),ACRCAT_":",2),";"),@ACROF
+3 WRITE " Authorities for: ",@ACRON,ACRUSER,@ACROF
+4 WRITE !!?10,"NO."
+5 WRITE ?15,"APPROVAL CATEGORY"
+6 WRITE !?10,"--- ---------------------------"
+7 SET (ACRJ,ACRAPDA)=0
+8 FOR
SET ACRAPDA=$ORDER(^ACRAPVT("C",ACRCAT,ACRAPDA))
IF 'ACRAPDA
QUIT
Begin DoDot:1
+9 SET ACRJ=ACRJ+1
+10 DO DISP1
End DoDot:1
+11 SET ACRMAX=ACRJ
+12 FOR ACRJ=1:1:ACRMAX
Begin DoDot:1
+13 WRITE !?10,$JUSTIFY(ACRJ,2)_") ",$PIECE(ACRZ(ACRJ),U,3)
+14 WRITE ?44,$SELECT($PIECE(ACRZ(ACRJ),U,2)=1:"<==",1:"")
+15 IF ACRJ=10
DO PAUSE^ACRFWARN
End DoDot:1
+16 KILL ACRAPDA
+17 IF '$DATA(ACROUT)
DO SELECT
+18 QUIT
DISP1 SET ACRZ=^ACRAPVT(ACRAPDA,0)
+1 SET ACRNAM=$PIECE(ACRZ,U)
+2 SET ACRORDR=$PIECE(ACRZ,U,4)
+3 SET ACRI=$SELECT($DATA(^ACRAPL("AC",ACRDUZ,ACRAPDA)):1,1:0)
+4 SET ACRZ(ACRORDR)=ACRAPDA_U_ACRI_U_$EXTRACT(ACRNAM,1,28)
+5 KILL ACRNAM,ACRORDR
+6 QUIT
DISP2 SET ACRJ2=ACRJ+ACRMAX
+1 WRITE !?2,$JUSTIFY(ACRJ,2),") ",$PIECE(ACRZ(ACRJ),U,3)
+2 WRITE ?34,$SELECT($PIECE(ACRZ(ACRJ),U,2)=1:"<==",1:"")
+3 IF $DATA(ACRZ(ACRJ2))
Begin DoDot:1
+4 WRITE ?42,$JUSTIFY(ACRJ2,2)_") ",$PIECE(ACRZ(ACRJ2),U,3)
+5 WRITE ?74,$SELECT($PIECE(ACRZ(ACRJ2),U,2)=1:"<==",1:"")
End DoDot:1
+6 QUIT
SELECT WRITE !!?10,"'<==' indicates user has this signature authority."
+1 WRITE !
+2 SET DIR(0)="SOA^A:Add APPROVAL AUTHORITIES;D:Delete APPROVAL AUTHORITIES;O:Exit APPROVAL Edit Sequence"
+3 SET DIR("A")=" (A)dd/(D)elete/(O)UT: "
+4 DO DIR^ACRFDIC
+5 IF Y="O"
SET ACROUT=""
QUIT
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+7 KILL ACRDR
+8 IF Y="D"
SET ACRDR=".01///@"
+9 SET DIR(0)="LO^1:"_ACRMAX
+10 SET DIR("A")=" Which AUTHORITY(IES)"
+11 WRITE !
+12 DO DIR^ACRFDIC
+13 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+14 SET ACRQK=Y(0)
+15 DO LOOP
QUIT
+16 QUIT
LOOP SET ACRQK1=ACRQK
+1 WRITE !
+2 FOR ACRLI=1:1
SET ACRQK=$PIECE(ACRQK1,",",ACRLI)
IF 'ACRQK!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
IF '$DATA(ACRZ(ACRQK))
QUIT
DO SET2
+3 KILL ACRCNT
+4 QUIT
SET2 SET ACRAPDA=$PIECE(ACRZ(ACRQK),U)
+1 SET ACRAP=$PIECE(^ACRAPVT(ACRAPDA,0),U)
+2 SET X=ACRDUZ
+3 SET (DIE,DIC)="^ACRAPL("
+4 SET DIC(0)="L"
+5 SET DIC("DR")=".02////"_ACRAPDA
+6 IF '$DATA(ACRDR)
Begin DoDot:1
+7 IF '$DATA(^ACRAPL("AC",ACRDUZ,ACRAPDA))
DO FILE^ACRFDIC
+8 IF ACRAPDA=21
IF '$DATA(^ACRAPL("AC",ACRDUZ,37))
Begin DoDot:2
+9 SET X=ACRDUZ
+10 SET DIC="^ACRAPL("
+11 SET DIC(0)="L"
+12 SET DIC("DR")=".02////37"
+13 DO FILE^ACRFDIC
End DoDot:2
+14 IF ACRAPDA=8
IF '$DATA(^ACRAPL("AC",ACRDUZ,45))
Begin DoDot:2
+15 SET X=ACRDUZ
+16 SET DIC="^ACRAPL("
+17 SET DIC(0)="L"
+18 SET DIC("DR")=".02////45"
+19 DO FILE^ACRFDIC
End DoDot:2
+20 WRITE !!,"Alternates for......: ",@ACRON,ACRUSER,@ACROF
+21 WRITE !,"when signing as the.: ",@ACRON,ACRAP,@ACROF
+22 SET DA=$ORDER(^ACRAPL("AC",ACRDUZ,ACRAPDA,0))
+23 SET DIE="^ACRAPL("
+24 SET DR="[ACR APPROVAL ALTERNATE]"
+25 IF DA
DO DDS^ACRFDIC
+26 IF $DATA(ACRSCREN)
KILL ACRSCREN
IF DA
DO DIE^ACRFDIC
End DoDot:1
QUIT
+27 SET DR=ACRDR
+28 SET DA=$ORDER(^ACRAPL("AC",ACRDUZ,ACRAPDA,0))
+29 IF DA
DO DIE^ACRFDIC
+30 QUIT
SETREQ ;EP;TO AUTOMATICALLY SET APPROVAL AUTHORITY FOR REQUEST INITIATOR,
+1 ;;TRAVEL REQUESTED BY AND TRAVELER FOR EVERY ARMS USER
+2 FOR ACRAPDA=32,36,40,41
IF '$DATA(^ACRAPL("AC",ACRDUZ,ACRAPDA))
Begin DoDot:1
+3 SET X=ACRDUZ
+4 SET DIC="^ACRAPL("
+5 SET DIC(0)="L"
+6 SET DIC("DR")=".02////"_ACRAPDA
+7 DO FILE^ACRFDIC
End DoDot:1
+8 QUIT
