- DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ;12/14/92 3/12/93
- ;;5.3;Registration;**13,35,1015**;Aug 13, 1993;Build 21
- RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES
- S DA=1,DR="720;721",DIE="^DG(43," D ^DIE G QUIT:X="^"!($D(DTOUT))!($D(Y)) K DA,DE,DQ,DR,DIE
- 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
- 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
- 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///"_$E(Y(0),1,3)_";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
- DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ;12/14/92 3/12/93
- +1 ;;5.3;Registration;**13,35,1015**;Aug 13, 1993;Build 21
- RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES
- +1 SET DA=1
- SET DR="720;721"
- SET DIE="^DG(43,"
- DO ^DIE
- IF X="^"!($DATA(DTOUT))!($DATA(Y))
- GOTO QUIT
- KILL DA,DE,DQ,DR,DIE
- +2 WRITE !!,"New travel rates are determined each fiscal year. The rates should be",!,"entered each year with the effective date of Oct 1.",!
- +3 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 SET DIR("A")="Select EFFECTIVE DATE"
- SET DIR(0)="DO^^E"
- SET DIR("?")="^D HELP1^DGBTEF1"
- +2 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO QUIT
- IF $EXTRACT(Y,4,7)'="1001"
- GOTO HELP
- SET X=+Y
- +3 SET DIC="^DG(43.1,"
- SET DIC(0)="ELQMZ"
- +4 DO ^DIC
- IF Y'>0
- GOTO QUIT
- SET DA=+Y
- +5 SET DGBTN=$SELECT('$DATA(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT"))
- +6 IF $DATA(DGBTN)&($PIECE(DGBTN,"^")]"")
- SET DIR("B")=$PIECE(DGBTN,"^")
- +7 SET DGBTDEDV=$$DEDUCT(6,"VISIT")
- IF DGBTDEDV<0
- GOTO QUIT1
- +8 SET DIE="^DG(43.1,"
- SET DR="30.01///^S X=DGBTDEDV"
- +9 DO ^DIE
- +10 IF $DATA(DGBTN)&($PIECE(DGBTN,"^",2)]"")
- SET DIR("B")=$PIECE(DGBTN,"^",2)
- +11 SET DGBTDEDM=$$DEDUCT(18,"MONTH")
- IF DGBTDEDM<0
- GOTO QUIT1
- +12 SET DIE="^DG(43.1,"
- SET DR="30.02///^S X=DGBTDEDM"
- +13 DO ^DIE
- +14 SET DR="30.03;30.05;30.04"
- SET DIE="^DG(43.1,"
- +15 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 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.",!
- +2 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///"_$EXTRACT(Y(0),1,3)_";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
