ACRFLBTX ;IHS/OIRM/DSD/THL,AEF - ADD TRANSACTION TYPES FOR DEPARTMENT ACCOUNTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE USED TO ADD TRANSACTION TYPES FOR DEPARTMENT ACCOUNTS
EN F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACRLBTX
Q
EN1 K ACRQUIT
S ACRLBTX=""
D DISPLAY^ACRFTXTP
D ADD
D SELECT:'$D(ACRQUIT)
Q
ADD W !!,"You may ADD or REMOVE Transaction which can be accessed by this department."
W !,"(** indicates that department has access to this type of transaction.)"
S DIR(0)="SO^1:ADD Transaction Types;2:REMOVE Transaction Types"
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
S:Y=2 ACRTXDEL=""
Q
SELECT S DIR(0)="LO^1:"_ACRJ
S DIR("A")="Select TRANSACTIONS to be used by this account"
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
N ACRI,ACRX,ACRY
S ACRY=Y
F ACRI=1:1 S ACRX=$P(ACRY,",",ACRI) Q:ACRX="" D
.S (DINUM,X,DA)=+ACRTX(ACRX)
.I $D(ACRTXDEL) D
..S DA(1)=ACRZDA
..S DIK="^ACRLOCB("_DA(1)_",2,"
..D DIK^ACRFDIC
.I '$D(ACRTXDEL),'$D(^ACRLOCB(ACRZDA,2,X)) D
..S:'$D(^ACRLOCB(ACRZDA,2,0)) ^ACRLOCB(ACRZDA,2,0)="^9002188.02P"
..S DA(1)=ACRZDA
..S DIC="^ACRLOCB("_DA(1)_",2,"
..S DIC(0)="L"
..D FILE^ACRFDIC
K ACRTXDEL
Q
ACRFLBTX ;IHS/OIRM/DSD/THL,AEF - ADD TRANSACTION TYPES FOR DEPARTMENT ACCOUNTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE USED TO ADD TRANSACTION TYPES FOR DEPARTMENT ACCOUNTS
EN FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACRLBTX
+1 QUIT
EN1 KILL ACRQUIT
+1 SET ACRLBTX=""
+2 DO DISPLAY^ACRFTXTP
+3 DO ADD
+4 IF '$DATA(ACRQUIT)
DO SELECT
+5 QUIT
ADD WRITE !!,"You may ADD or REMOVE Transaction which can be accessed by this department."
+1 WRITE !,"(** indicates that department has access to this type of transaction.)"
+2 SET DIR(0)="SO^1:ADD Transaction Types;2:REMOVE Transaction Types"
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 IF Y=2
SET ACRTXDEL=""
+6 QUIT
SELECT SET DIR(0)="LO^1:"_ACRJ
+1 SET DIR("A")="Select TRANSACTIONS to be used by this account"
+2 DO DIR^ACRFDIC
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+4 NEW ACRI,ACRX,ACRY
+5 SET ACRY=Y
+6 FOR ACRI=1:1
SET ACRX=$PIECE(ACRY,",",ACRI)
IF ACRX=""
QUIT
Begin DoDot:1
+7 SET (DINUM,X,DA)=+ACRTX(ACRX)
+8 IF $DATA(ACRTXDEL)
Begin DoDot:2
+9 SET DA(1)=ACRZDA
+10 SET DIK="^ACRLOCB("_DA(1)_",2,"
+11 DO DIK^ACRFDIC
End DoDot:2
+12 IF '$DATA(ACRTXDEL)
IF '$DATA(^ACRLOCB(ACRZDA,2,X))
Begin DoDot:2
+13 IF '$DATA(^ACRLOCB(ACRZDA,2,0))
SET ^ACRLOCB(ACRZDA,2,0)="^9002188.02P"
+14 SET DA(1)=ACRZDA
+15 SET DIC="^ACRLOCB("_DA(1)_",2,"
+16 SET DIC(0)="L"
+17 DO FILE^ACRFDIC
End DoDot:2
End DoDot:1
+18 KILL ACRTXDEL
+19 QUIT