ACRFTXT1.m

ACRFTXT1 ;IHS/OIRM/DSD/THL,AEF - EDIT TRANSACTION TYPE USER ACCESS; [ 09/26/2005   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 ;;ROUTINE TO EDIT TRANSACTION TYPE USER ACCESS

EN F  D EN1 Q:'$D(ACRDUZ)

EXIT K ACRX,ACRTXNAM,ACRTX,ACRTXPFX,ACRQUIT,ACRDOCDA,ACRTXDOC,ACRDATA,ACRDUZ,ACRJ,ACRI,ACRQK,ACRCNT,ACRLI,ACRUSER,ACR,ACRQK1,ACRZ,ACRMAX

 Q

EN1 W @IOF

 W !?22,"EDIT USER TRANSACTION ACCESS"

 W !?22,"============================"

 S DIC="^VA(200,"

 S DIC(0)="AEMQZ"

 S DIC("A")="EMPLOYEE............: "

 W !

 D DIC^ACRFDIC

 I $E(X)["U"!(+Y<1) S ACRQUIT="" K ACRDUZ Q

 S ACRDUZ=+Y

 ; S ACRUSER=Y(0,0)                                 ;ACR*2.1*19.02 IM16848

 ; S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",")  ;ACR*2.1*19.02  IM16848

 S ACRUSER=$$NAME3^ACRFUTL1(+Y)                     ;ACR*2.1*19.02 IM16848

 F  D DISPLAY Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRQUIT

 Q

DISPLAY W @IOF

 W !,"Transaction access for: ",@ACRON,ACRUSER,@ACROF

 W !!,"NO."

 W ?5,"TYPE OF TRANSACTION"

 W ?40,"NO."

 W ?45,"TYPE OF TRANSACTION"

 W !,"---"

 W ?5,"-----------------------------"

 W ?40,"---"

 W ?45,"-----------------------------"

 S (ACRTXDO,ACRJ)=0

 F  S ACRTXDO=$O(^ACRTXTYP("DO",ACRTXDO)) Q:'ACRTXDO  D

 .S ACRY=0

 .F  S ACRY=$O(^ACRTXTYP("DO",ACRTXDO,ACRY)) Q:'ACRY  D

 ..S ACRJ=ACRJ+1

 ..S ACRX=$P(^ACRTXTYP(ACRY,0),U)

 ..S ACRDATA(ACRJ)=ACRY_U_ACRX

 S ACRMAX=ACRJ\2+(ACRJ#2)

 S ACRJ=0

 F  S ACRJ=$O(ACRDATA(ACRJ)) Q:'ACRJ!(ACRJ>(ACRMAX))  D

 .S ACRY=$P(ACRDATA(ACRJ),U)

 .S ACRX=$P(ACRDATA(ACRJ),U,2)

 .W !,$J(ACRJ,2)_")"

 .W ?$X+2,ACRX

 .W ?35

 .D ACRK

 .S ACRZ(ACRJ)=ACRY

 .D D1:$D(ACRDATA(ACRJ+ACRMAX))

 S ACRJ=$S('ACRJ:ACRMAX,$D(ACRDATA(ACRJ-1+ACRMAX)):ACRJ+ACRMAX,1:ACRJ+ACRMAX-1)

 W:ACRJ#2=1 !

 W:ACRJ#2=0 ?40

 W $J(ACRJ,2),")  All data types"

DISP1 W !!?10,"'<==' indicates user already has access to the transaction."

 S DIR(0)="SO^1:Add TRANSACTION TYPES 1 thru 10;2:Add OTHER TYPES;3:Delete TRANSACTION TYPE(S)^K:X'?1N!(X<1)!(X>3) X"

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRDR

 I X=1 S ACRJ=11 D ALL Q

 I X=3 S ACRDR=".01///@"

 S DIR(0)="LO^1:"_(ACRJ)

 S DIR("A")="Select transaction type(s) ==> "

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)

 S ACRQK=Y(0)

 S:$E(ACRQK,$L(ACRQK))="," ACRQK=$E(ACRQK,1,$L(ACRQK)-1)

 S ACRQK=$P(ACRQK,",20")

 I ACRQK["," D LOOP Q

 I ACRQK=ACRJ D ALL Q

 D SET2

 Q

D1 S ACRX=$P(ACRDATA(ACRJ+ACRMAX),U,2)

 S ACRY=$P(ACRDATA(ACRJ+ACRMAX),U)

 W ?40,$J(ACRJ+ACRMAX,2),")"

 W ?$X+2,ACRX

 W ?76

 D ACRK

 S ACRZ(ACRJ+ACRMAX)=ACRY

 Q

LOOP S:ACRQK[",20" ACRQK=$P(ACRQK,",20")

 S ACRCNT=$L(ACRQK,",")

 S ACRQK1=ACRQK

 W !

 D:$E($G(IOST),1,2)="C-" WAIT^DICD

 W !

 F ACRLI=1:1:ACRCNT S ACRQK=$P(ACRQK1,",",ACRLI) D SET2

 Q

SLT1 S ACRY=0

 F  S ACRY=$O(^ACRTXTYP("DO",ACR,ACRY)) Q:'ACRY  D

 .S ACRJ=ACRJ+1

 .S ACRX=$P(^ACRTXTYP(ACRY,0),U)

 .W:ACRJ#2=1 !

 .W:ACRJ#2=0 ?40

 .W $J(ACRJ,2)_")"

 .W ?$X+2,ACRX

 .W ?35

 .D ACRK

 .S ACRZ(ACRJ)=ACRY

 Q

SET2 S (ACRTXDA,DA(1))=ACRZ(ACRQK)

 S (X,DINUM)=ACRDUZ

 S DIC="^ACRTXTYP("_ACRTXDA_",""ACCESS"","

 S DIC(0)="L"

 I '$D(^ACRTXTYP(ACRTXDA,"ACCESS",0)) S ^(0)="^9002194.01P^^"

 I '$D(ACRDR) D FILE^ACRFDIC Q

 S DA=ACRDUZ

 S DIE="^ACRTXTYP("_ACRTXDA_",""ACCESS"","

 S DR=ACRDR

 D DIE^ACRFDIC

 Q

ALL F ACRQK=1:1:(ACRJ-1) D SET2

 Q

ACRK I $D(^ACRTXTYP(ACRY,"ACCESS","B",ACRDUZ)) W "<=="

 Q

ACRFTXT1  ;IHS/OIRM/DSD/THL,AEF - EDIT TRANSACTION TYPE USER ACCESS; [ 09/26/2005   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 +2       ;;ROUTINE TO EDIT TRANSACTION TYPE USER ACCESS

EN         FOR 

               DO EN1

               IF '$DATA(ACRDUZ)

                   QUIT 

EXIT       KILL ACRX,ACRTXNAM,ACRTX,ACRTXPFX,ACRQUIT,ACRDOCDA,ACRTXDOC,ACRDATA,ACRDUZ,ACRJ,ACRI,ACRQK,ACRCNT,ACRLI,ACRUSER,ACR,ACRQK1,ACRZ,ACRMAX

 +1        QUIT 

EN1        WRITE @IOF

 +1        WRITE !?22,"EDIT USER TRANSACTION ACCESS"

 +2        WRITE !?22,"============================"

 +3        SET DIC="^VA(200,"

 +4        SET DIC(0)="AEMQZ"

 +5        SET DIC("A")="EMPLOYEE............: "

 +6        WRITE !

 +7        DO DIC^ACRFDIC

 +8        IF $EXTRACT(X)["U"!(+Y<1)

               SET ACRQUIT=""

               KILL ACRDUZ

               QUIT 

 +9        SET ACRDUZ=+Y

 +10      ; S ACRUSER=Y(0,0)                                 ;ACR*2.1*19.02 IM16848

 +11      ; S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",")  ;ACR*2.1*19.02  IM16848

 +12      ;ACR*2.1*19.02 IM16848

           SET ACRUSER=$$NAME3^ACRFUTL1(+Y)

 +13       FOR 

               DO DISPLAY

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

 +14       KILL ACRQUIT

 +15       QUIT 

DISPLAY    WRITE @IOF

 +1        WRITE !,"Transaction access for: ",@ACRON,ACRUSER,@ACROF

 +2        WRITE !!,"NO."

 +3        WRITE ?5,"TYPE OF TRANSACTION"

 +4        WRITE ?40,"NO."

 +5        WRITE ?45,"TYPE OF TRANSACTION"

 +6        WRITE !,"---"

 +7        WRITE ?5,"-----------------------------"

 +8        WRITE ?40,"---"

 +9        WRITE ?45,"-----------------------------"

 +10       SET (ACRTXDO,ACRJ)=0

 +11       FOR 

               SET ACRTXDO=$ORDER(^ACRTXTYP("DO",ACRTXDO))

               IF 'ACRTXDO

                   QUIT 

               Begin DoDot:1

 +12               SET ACRY=0

 +13               FOR 

                       SET ACRY=$ORDER(^ACRTXTYP("DO",ACRTXDO,ACRY))

                       IF 'ACRY

                           QUIT 

                       Begin DoDot:2

 +14                       SET ACRJ=ACRJ+1

 +15                       SET ACRX=$PIECE(^ACRTXTYP(ACRY,0),U)

 +16                       SET ACRDATA(ACRJ)=ACRY_U_ACRX

                       End DoDot:2

               End DoDot:1

 +17       SET ACRMAX=ACRJ\2+(ACRJ#2)

 +18       SET ACRJ=0

 +19       FOR 

               SET ACRJ=$ORDER(ACRDATA(ACRJ))

               IF 'ACRJ!(ACRJ>(ACRMAX))

                   QUIT 

               Begin DoDot:1

 +20               SET ACRY=$PIECE(ACRDATA(ACRJ),U)

 +21               SET ACRX=$PIECE(ACRDATA(ACRJ),U,2)

 +22               WRITE !,$JUSTIFY(ACRJ,2)_")"

 +23               WRITE ?$X+2,ACRX

 +24               WRITE ?35

 +25               DO ACRK

 +26               SET ACRZ(ACRJ)=ACRY

 +27               IF $DATA(ACRDATA(ACRJ+ACRMAX))

                       DO D1

               End DoDot:1

 +28       SET ACRJ=$SELECT('ACRJ:ACRMAX,$DATA(ACRDATA(ACRJ-1+ACRMAX)):ACRJ+ACRMAX,1:ACRJ+ACRMAX-1)

 +29       IF ACRJ#2=1

               WRITE !

 +30       IF ACRJ#2=0

               WRITE ?40

 +31       WRITE $JUSTIFY(ACRJ,2),")  All data types"

DISP1      WRITE !!?10,"'<==' indicates user already has access to the transaction."

 +1        SET DIR(0)="SO^1:Add TRANSACTION TYPES 1 thru 10;2:Add OTHER TYPES;3:Delete TRANSACTION TYPE(S)^K:X'?1N!(X<1)!(X>3) X"

 +2        DO DIR^ACRFDIC

 +3        IF $DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT 

 +4        KILL ACRDR

 +5        IF X=1

               SET ACRJ=11

               DO ALL

               QUIT 

 +6        IF X=3

               SET ACRDR=".01///@"

 +7        SET DIR(0)="LO^1:"_(ACRJ)

 +8        SET DIR("A")="Select transaction type(s) ==> "

 +9        WRITE !

 +10       DO DIR^ACRFDIC

 +11       IF $DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT 

 +12       SET ACRQK=Y(0)

 +13       IF $EXTRACT(ACRQK,$LENGTH(ACRQK))=","

               SET ACRQK=$EXTRACT(ACRQK,1,$LENGTH(ACRQK)-1)

 +14       SET ACRQK=$PIECE(ACRQK,",20")

 +15       IF ACRQK[","

               DO LOOP

               QUIT 

 +16       IF ACRQK=ACRJ

               DO ALL

               QUIT 

 +17       DO SET2

 +18       QUIT 

D1         SET ACRX=$PIECE(ACRDATA(ACRJ+ACRMAX),U,2)

 +1        SET ACRY=$PIECE(ACRDATA(ACRJ+ACRMAX),U)

 +2        WRITE ?40,$JUSTIFY(ACRJ+ACRMAX,2),")"

 +3        WRITE ?$X+2,ACRX

 +4        WRITE ?76

 +5        DO ACRK

 +6        SET ACRZ(ACRJ+ACRMAX)=ACRY

 +7        QUIT 

LOOP       IF ACRQK[",20"

               SET ACRQK=$PIECE(ACRQK,",20")

 +1        SET ACRCNT=$LENGTH(ACRQK,",")

 +2        SET ACRQK1=ACRQK

 +3        WRITE !

 +4        IF $EXTRACT($GET(IOST),1,2)="C-"

               DO WAIT^DICD

 +5        WRITE !

 +6        FOR ACRLI=1:1:ACRCNT

               SET ACRQK=$PIECE(ACRQK1,",",ACRLI)

               DO SET2

 +7        QUIT 

SLT1       SET ACRY=0

 +1        FOR 

               SET ACRY=$ORDER(^ACRTXTYP("DO",ACR,ACRY))

               IF 'ACRY

                   QUIT 

               Begin DoDot:1

 +2                SET ACRJ=ACRJ+1

 +3                SET ACRX=$PIECE(^ACRTXTYP(ACRY,0),U)

 +4                IF ACRJ#2=1

                       WRITE !

 +5                IF ACRJ#2=0

                       WRITE ?40

 +6                WRITE $JUSTIFY(ACRJ,2)_")"

 +7                WRITE ?$X+2,ACRX

 +8                WRITE ?35

 +9                DO ACRK

 +10               SET ACRZ(ACRJ)=ACRY

               End DoDot:1

 +11       QUIT 

SET2       SET (ACRTXDA,DA(1))=ACRZ(ACRQK)

 +1        SET (X,DINUM)=ACRDUZ

 +2        SET DIC="^ACRTXTYP("_ACRTXDA_",""ACCESS"","

 +3        SET DIC(0)="L"

 +4        IF '$DATA(^ACRTXTYP(ACRTXDA,"ACCESS",0))

               SET ^(0)="^9002194.01P^^"

 +5        IF '$DATA(ACRDR)

               DO FILE^ACRFDIC

               QUIT 

 +6        SET DA=ACRDUZ

 +7        SET DIE="^ACRTXTYP("_ACRTXDA_",""ACCESS"","

 +8        SET DR=ACRDR

 +9        DO DIE^ACRFDIC

 +10       QUIT 

ALL        FOR ACRQK=1:1:(ACRJ-1)

               DO SET2

 +1        QUIT 

ACRK       IF $DATA(^ACRTXTYP(ACRY,"ACCESS","B",ACRDUZ))

               WRITE "<=="

 +1        QUIT