DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ; 1/5/24 11:29am
;;1.0;Beneficiary Travel;**2,14,41**;September 25, 2001;Build 7
RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES
S DA=1,DR="720;723;721",DIE="^DG(43," D ^DIE G QUIT:X="^"!($D(DTOUT))!($D(Y)) K DA,DE,DQ,DR,DIE
Q ;This Q was added under direction of CBO to remove site's ability to edit rates
W !!,"New travel rates are determined each fiscal year. The rates should be",!,"entered each year with the effective date of Oct 1.",!
W !,"Changing values for the current or past fiscal years could result in changes",!,"to the claims already entered.",!
DATE ; change deductible rates for FY
Q ;This Q was added under direction of CBO to remove site's ability to edit rates
S DIR("A")="Select EFFECTIVE DATE",DIR(0)="DO^^E",DIR("?")="^D HELP1^DGBTEF1"
D ^DIR K DIR G QUIT:$D(DIRUT) G HELP:$E(Y,4,7)'="1001" S X=+Y
S DIC="^DG(43.1,",DIC(0)="ELQMZ"
D ^DIC G QUIT:Y'>0 S DA=+Y
S DGBTN=$S('$D(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT"))
S:$D(DGBTN)&($P(DGBTN,"^")]"") DIR("B")=$P(DGBTN,"^")
S DGBTDEDV=$$DEDUCT(6,"VISIT") G:DGBTDEDV<0 QUIT1
S DIE="^DG(43.1,",DR="30.01///^S X=DGBTDEDV"
D ^DIE
S:$D(DGBTN)&($P(DGBTN,"^",2)]"") DIR("B")=$P(DGBTN,"^",2)
S DGBTDEDM=$$DEDUCT(18,"MONTH") G:DGBTDEDM<0 QUIT1
S DIE="^DG(43.1,",DR="30.02///^S X=DGBTDEDM"
D ^DIE
S DR="30.03;30.05;30.04",DIE="^DG(43.1,"
D ^DIE G QUIT1
ACCT ; change activation/inactivation dates for accounts
W !!,"ACCOUNT TYPES are determined by Fiscal Service and have a direct impact",!,"on the type of questions asked in the Beneficiary Travel CLAIM ENTER/EDIT",!,"option."
W !,"DO NOT add to this file unless so instructed by Fiscal Service.",!
TYPE ; select account to edit
S DIR("A")="Select ACCOUNT",DIR("?")="^D HELP2^DGBTEF1",DIR(0)="FO"
D ^DIR K DIR G QUIT:$D(DIRUT) S X=Y
S DIC="^DGBT(392.3,",DIC(0)="ELQMZ"
D ^DIC G TYPE:Y'>0
S DA=+Y,DR="2:4",DIE="^DGBT(392.3," D ^DIE G TYPE
NWACT ;enter/edit account file (392.3);option DGBT BENE TRAVEL ACCOUNT
Q ;DGBT*1*41 Removing functionality
W !!?3,"You are about to enter/edit Bene Travel account types. Although",!?3,"this process is now decentralized, changes and additions should be",!?3,"made with extreme care.",!
S DIR(0)="Y",DIR("A")="Are you sure you wish to continue",DIR("B")="No" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!('Y) G QUIT1
ED ; edit data for new account
W ! K X,DA
S (DIE,DIC)="^DGBT(392.3,",DIC(0)="AEQLMZ",DLAYGO=392.3,DIC("DR")=""
D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT)!(X="") QUIT1 G:Y'>0 ED
S DR="2///"_$P(Y(0)," ",1)_";3;4;5" ; account number now stuffed, not asked
S DA=+Y L ^DGBT(392.3,DA):2 E W !?5,"Another user is editing this entry.",*7 G ED
S DIE("NO^")=1
D ^DIE L K DR,DIE,DIE("NO^")
W ! S DIR(0)="Y",DIR("A")="Would you like to Enter/Edit another ACCOUNT",DIR("B")="Yes"
D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(Y=0) QUIT1 G ED
QUIT1 ;
K DIR,DTOUT,DI,D0,DUOUT,DIRUT,DGBTN,DGBTDEDV,DGBTDEDM
QUIT ;
K %DT,DA,DIC,DIE,DIE("NO^"),DR,X,Y Q
DEDUCT(LIMIT,TYPE) ; enter new deductble value
DEDCT1 S DIR(0)="FAO",DIR("A")="ENTER DEDUCTIBLE AMOUNT/"_TYPE_": "
S DIR("?")="Type a dollar amount between 0 and "_LIMIT_" with up to 2 decimal places."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT))!(Y']"") S Y=-1 G DEDUCTQ
S:Y["$" Y=$P(Y,"$",2)
I Y'?.N,Y'?.N1".".N K X,Y,DIR G DEDCT1
I Y>(LIMIT+.001) W " -- Deductible exceeds limit." K X,Y,DIR G DEDCT1
DEDUCTQ Q (+Y)
;
HELP W !!,"The effective date must start on the fiscal year, Oct 1.",! G DATE
HELP1 S DIC="^DG(43.1,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q
HELP2 S DIC="^DGBT(392.3,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTEF1 3699 printed Nov 22, 2024@16:50:57 Page 2
DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ; 1/5/24 11:29am
+1 ;;1.0;Beneficiary Travel;**2,14,41**;September 25, 2001;Build 7
RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES
+1 SET DA=1
SET DR="720;723;721"
SET DIE="^DG(43,"
DO ^DIE
if X="^"!($DATA(DTOUT))!($DATA(Y))
GOTO QUIT
KILL DA,DE,DQ,DR,DIE
+2 ;This Q was added under direction of CBO to remove site's ability to edit rates
QUIT
+3 WRITE !!,"New travel rates are determined each fiscal year. The rates should be",!,"entered each year with the effective date of Oct 1.",!
+4 WRITE !,"Changing values for the current or past fiscal years could result in changes",!,"to the claims already entered.",!
DATE ; change deductible rates for FY
+1 ;This Q was added under direction of CBO to remove site's ability to edit rates
QUIT
+2 SET DIR("A")="Select EFFECTIVE DATE"
SET DIR(0)="DO^^E"
SET DIR("?")="^D HELP1^DGBTEF1"
+3 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
if $EXTRACT(Y,4,7)'="1001"
GOTO HELP
SET X=+Y
+4 SET DIC="^DG(43.1,"
SET DIC(0)="ELQMZ"
+5 DO ^DIC
if Y'>0
GOTO QUIT
SET DA=+Y
+6 SET DGBTN=$SELECT('$DATA(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT"))
+7 if $DATA(DGBTN)&($PIECE(DGBTN,"^")]"")
SET DIR("B")=$PIECE(DGBTN,"^")
+8 SET DGBTDEDV=$$DEDUCT(6,"VISIT")
if DGBTDEDV<0
GOTO QUIT1
+9 SET DIE="^DG(43.1,"
SET DR="30.01///^S X=DGBTDEDV"
+10 DO ^DIE
+11 if $DATA(DGBTN)&($PIECE(DGBTN,"^",2)]"")
SET DIR("B")=$PIECE(DGBTN,"^",2)
+12 SET DGBTDEDM=$$DEDUCT(18,"MONTH")
if DGBTDEDM<0
GOTO QUIT1
+13 SET DIE="^DG(43.1,"
SET DR="30.02///^S X=DGBTDEDM"
+14 DO ^DIE
+15 SET DR="30.03;30.05;30.04"
SET DIE="^DG(43.1,"
+16 DO ^DIE
GOTO QUIT1
ACCT ; change activation/inactivation dates for accounts
+1 WRITE !!,"ACCOUNT TYPES are determined by Fiscal Service and have a direct impact",!,"on the type of questions asked in the Beneficiary Travel CLAIM ENTER/EDIT",!,"option."
+2 WRITE !,"DO NOT add to this file unless so instructed by Fiscal Service.",!
TYPE ; select account to edit
+1 SET DIR("A")="Select ACCOUNT"
SET DIR("?")="^D HELP2^DGBTEF1"
SET DIR(0)="FO"
+2 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
SET X=Y
+3 SET DIC="^DGBT(392.3,"
SET DIC(0)="ELQMZ"
+4 DO ^DIC
if Y'>0
GOTO TYPE
+5 SET DA=+Y
SET DR="2:4"
SET DIE="^DGBT(392.3,"
DO ^DIE
GOTO TYPE
NWACT ;enter/edit account file (392.3);option DGBT BENE TRAVEL ACCOUNT
+1 ;DGBT*1*41 Removing functionality
QUIT
+2 WRITE !!?3,"You are about to enter/edit Bene Travel account types. Although",!?3,"this process is now decentralized, changes and additions should be",!?3,"made with extreme care.",!
+3 SET DIR(0)="Y"
SET DIR("A")="Are you sure you wish to continue"
SET DIR("B")="No"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))!('Y)
GOTO QUIT1
ED ; edit data for new account
+1 WRITE !
KILL X,DA
+2 SET (DIE,DIC)="^DGBT(392.3,"
SET DIC(0)="AEQLMZ"
SET DLAYGO=392.3
SET DIC("DR")=""
+3 DO ^DIC
KILL DIC
if $DATA(DTOUT)!$DATA(DUOUT)!(X="")
GOTO QUIT1
if Y'>0
GOTO ED
+4 ; account number now stuffed, not asked
SET DR="2///"_$PIECE(Y(0)," ",1)_";3;4;5"
+5 SET DA=+Y
LOCK ^DGBT(392.3,DA):2
IF '$TEST
WRITE !?5,"Another user is editing this entry.",*7
GOTO ED
+6 SET DIE("NO^")=1
+7 DO ^DIE
LOCK
KILL DR,DIE,DIE("NO^")
+8 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Would you like to Enter/Edit another ACCOUNT"
SET DIR("B")="Yes"
+9 DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))!(Y=0)
GOTO QUIT1
GOTO ED
QUIT1 ;
+1 KILL DIR,DTOUT,DI,D0,DUOUT,DIRUT,DGBTN,DGBTDEDV,DGBTDEDM
QUIT ;
+1 KILL %DT,DA,DIC,DIE,DIE("NO^"),DR,X,Y
QUIT
DEDUCT(LIMIT,TYPE) ; enter new deductble value
DEDCT1 SET DIR(0)="FAO"
SET DIR("A")="ENTER DEDUCTIBLE AMOUNT/"_TYPE_": "
+1 SET DIR("?")="Type a dollar amount between 0 and "_LIMIT_" with up to 2 decimal places."
+2 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))!(Y']"")
SET Y=-1
GOTO DEDUCTQ
+3 if Y["$"
SET Y=$PIECE(Y,"$",2)
+4 IF Y'?.N
IF Y'?.N1".".N
KILL X,Y,DIR
GOTO DEDCT1
+5 IF Y>(LIMIT+.001)
WRITE " -- Deductible exceeds limit."
KILL X,Y,DIR
GOTO DEDCT1
DEDUCTQ QUIT (+Y)
+1 ;
HELP WRITE !!,"The effective date must start on the fiscal year, Oct 1.",!
GOTO DATE
HELP1 SET DIC="^DG(43.1,"
SET DIC(0)="QMZ"
SET X="?"
DO ^DIC
KILL DIC
QUIT
HELP2 SET DIC="^DGBT(392.3,"
SET DIC(0)="QMZ"
SET X="?"
DO ^DIC
KILL DIC
QUIT
