ACRFDRC1.m

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