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
