DGBTEE.m

DGBTEE ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT; 12/3/92@1600

 ;;5.3;Registration;**13,60,186,1015**;Aug 13, 1993;Build 21

 Q

SCREEN ;

 D SCREEN^DGBTEE1 Q:DGBTTOUT=-1!(DGBTTOUT=1)  Q:'$D(^DGBT(392,DGBTDT,0))

 ;  The following section of code moved to DGBTEE2 for space problems

 D STUFF^DGBTEE2

MILES ;  get miles between dep. and dest. using function call to DGBTUTL

 K X,DGBTREC S (DGBTOWRT,DGBTML,DGBTMLT)=""

 I DGBTFR4]""&((DGBTACCT=4)!(DGBTACCT=5)) I $D(^DGBT(392.1,"ACS",DGBTFR4,+VAPA(5))) D

 . S X=$O(^(+VAPA(5),0)) ; naked ref. refers to file #392.1, "ACS", city.  Full reference on line MILES+2^DGBTEE, ^DGBTE(392.1,"ACS",DGBTFR4,+VAPA(5)

 . ;  function $$miles passes city's record# and div name to function, mileage value is returned

 . I X'="" S DGBTREC=X,DGBTML=$$MILES^DGBTUTL(DGBTREC,DGBTDV1),DGBTOWRT="ROUND TRIP" K X

 S (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDCV,DGBTDE,DGBTDCM,DGBTDPV,DGBTDPM)=0

DIE1 ;  stuff from,to address, meals, ferry's/bridges

 Q:'$D(^DGBT(392,DGBTDT,0))

 S DIE="^DGBT(392,",DA=DGBTDT,DR=$S(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44")

 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q

 S DR="21////^S X=DGBTFR1;22////^S X=DGBTFR2;23////^S X=DGBTFR3;24////^S X=DGBTFR4;25////^S X=DGBTTO1;26////^S X=DGBTTO2;27////^S X=DGBTTO3;28////^S X=DGBTTO4;34////^S X=DGBTMAL;35////^S X=DGBTFAB"

 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q

 ;  function $$diclkup passes the city's record #, div name, and a flag for remarks (4), remarks or a null are returned

 I DGBTACCT=4!(DGBTACCT=5) D

 . W !!,"Please wait, Checking Mileage ..."

 . S DGBTRMK=$S($D(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,4),1:"") I $D(DGBTDEF),DGBTDEF S DGBTRMK="DEFAULT MILEAGE USED"

 . I DGBTRMK]"" W !,*7,"MILEAGE REMARKS: ",DGBTRMK,!

EDIT ;  display trip type, mileage

 I DGBTACCT=4!(DGBTACCT=5) S DR="32//"_DGBTML_";S DGBTML=X;31//"_DGBTOWRT_";S DGBTOWRT=X;" D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q

 S:DGBTACCT=5&(DGBTCP=1) DGBTMR=DGBTMR1 S DGBTMLT=DGBTOWRT*DGBTML*DGBTMR,DR="33///"_DGBTMLT

 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q

DIE2 ;  stuff eligibility data, SC%, acct. type

 S DIE("NO^")="12345" S:'$D(DGBTCD) DGBTCD=""

 S DR="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD_";6////"_DGBTACTN_";I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;7;@1;I DGBTMLFB=0 S Y=""@2"";34;S DGBTMAL=X;35;S DGBTFAB=X;@2"

DIE3 ;  get most econ. cost

 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q

 ;  function $$diclkup passes the city's record #, division name, and flag for MEC (3), the MEC is returned

 S:$D(DGBTREC) DGBTME=$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,3) S:DGBTME="" DGBTME=0 S DR="8//"_DGBTME_";S DGBTME=X"

 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 G EXIT

TCOST ; calculate total cost and monthly cum. deductable

MLFB ;

 S DGBTMAF=$S(DGBTMLFB:DGBTMAL+DGBTFAB,1:0),DGBTMETC=DGBTME+$S($D(DGBTMAL):DGBTMAL,1:0)

 I DGBTACCT'=4&(DGBTACCT'=5) S DGBTPA=DGBTMAF+DGBTME G CONT

 I $D(DGBTMLT) S DGBTTC=$S(DGBTMLT+DGBTMAF'>DGBTMETC:DGBTMLT+DGBTMAF,DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0):DGBTMETC,DGBTME'>0:DGBTMLT+DGBTMAF,1:DGBTMETC)

 I DGBTACCT=5 S DGBTDE=0 S DGBTPA=$S((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC) G CONT

 ;  the following section of code moved to DGBTEE2 for space reasons

 D DED^DGBTEE2

DIE4 ;  display deductable amount

 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q

CONT ;

 D CONT^DGBTCE1 Q

EXIT ;

 K DGBTDV1,DGBTRMK Q

DGBTEE    ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT; 12/3/92@1600

 +1       ;;5.3;Registration;**13,60,186,1015**;Aug 13, 1993;Build 21

 +2        QUIT 

SCREEN    ;

 +1        DO SCREEN^DGBTEE1

           IF DGBTTOUT=-1!(DGBTTOUT=1)

               QUIT 

           IF '$DATA(^DGBT(392,DGBTDT,0))

               QUIT 

 +2       ;  The following section of code moved to DGBTEE2 for space problems

 +3        DO STUFF^DGBTEE2

MILES     ;  get miles between dep. and dest. using function call to DGBTUTL

 +1        KILL X,DGBTREC

           SET (DGBTOWRT,DGBTML,DGBTMLT)=""

 +2        IF DGBTFR4]""&((DGBTACCT=4)!(DGBTACCT=5))

               IF $DATA(^DGBT(392.1,"ACS",DGBTFR4,+VAPA(5)))

                   Begin DoDot:1

 +3       ; naked ref. refers to file #392.1, "ACS", city.  Full reference on line MILES+2^DGBTEE, ^DGBTE(392.1,"ACS",DGBTFR4,+VAPA(5)

                       SET X=$ORDER(^(+VAPA(5),0))

 +4       ;  function $$miles passes city's record# and div name to function, mileage value is returned

 +5                    IF X'=""

                           SET DGBTREC=X

                           SET DGBTML=$$MILES^DGBTUTL(DGBTREC,DGBTDV1)

                           SET DGBTOWRT="ROUND TRIP"

                           KILL X

                   End DoDot:1

 +6        SET (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDCV,DGBTDE,DGBTDCM,DGBTDPV,DGBTDPM)=0

DIE1      ;  stuff from,to address, meals, ferry's/bridges

 +1        IF '$DATA(^DGBT(392,DGBTDT,0))

               QUIT 

 +2        SET DIE="^DGBT(392,"

           SET DA=DGBTDT

           SET DR=$SELECT(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44")

 +3        DO ^DIE

           IF X=""!(X="^")

               SET DGBTTOUT=-1

               QUIT 

 +4        SET DR="21////^S X=DGBTFR1;22////^S X=DGBTFR2;23////^S X=DGBTFR3;24////^S X=DGBTFR4;25////^S X=DGBTTO1;26////^S X=DGBTTO2;27////^S X=DGBTTO3;28////^S X=DGBTTO4;34////^S X=DGBTMAL;35////^S X=DGBTFAB"

 +5        DO ^DIE

           IF X=""!(X="^")

               SET DGBTTOUT=-1

               QUIT 

 +6       ;  function $$diclkup passes the city's record #, div name, and a flag for remarks (4), remarks or a null are returned

 +7        IF DGBTACCT=4!(DGBTACCT=5)

               Begin DoDot:1

 +8                WRITE !!,"Please wait, Checking Mileage ..."

 +9                SET DGBTRMK=$SELECT($DATA(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,4),1:"")

                   IF $DATA(DGBTDEF)

                       IF DGBTDEF

                           SET DGBTRMK="DEFAULT MILEAGE USED"

 +10               IF DGBTRMK]""

                       WRITE !,*7,"MILEAGE REMARKS: ",DGBTRMK,!

               End DoDot:1

EDIT      ;  display trip type, mileage

 +1        IF DGBTACCT=4!(DGBTACCT=5)

               SET DR="32//"_DGBTML_";S DGBTML=X;31//"_DGBTOWRT_";S DGBTOWRT=X;"

               DO ^DIE

               IF X=""!(X="^")

                   SET DGBTTOUT=-1

                   QUIT 

 +2        IF DGBTACCT=5&(DGBTCP=1)

               SET DGBTMR=DGBTMR1

           SET DGBTMLT=DGBTOWRT*DGBTML*DGBTMR

           SET DR="33///"_DGBTMLT

 +3        DO ^DIE

           IF X=""!(X="^")

               SET DGBTTOUT=-1

               QUIT 

DIE2      ;  stuff eligibility data, SC%, acct. type

 +1        SET DIE("NO^")="12345"

           IF '$DATA(DGBTCD)

               SET DGBTCD=""

 +2        SET DR="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD_";6////"_DGBTACTN_";I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;7;@1;I DGBTMLFB=0 S Y=""@2"";34;S DGBTMAL=X;35;S DGBTFAB=X;@2"

DIE3      ;  get most econ. cost

 +1        DO ^DIE

           IF X=""!(X="^")

               SET DGBTTOUT=-1

               QUIT 

 +2       ;  function $$diclkup passes the city's record #, division name, and flag for MEC (3), the MEC is returned

 +3        IF $DATA(DGBTREC)

               SET DGBTME=$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,3)

           IF DGBTME=""

               SET DGBTME=0

           SET DR="8//"_DGBTME_";S DGBTME=X"

 +4        DO ^DIE

           IF X=""!(X="^")

               SET DGBTTOUT=-1

               GOTO EXIT

TCOST     ; calculate total cost and monthly cum. deductable

MLFB      ;

 +1        SET DGBTMAF=$SELECT(DGBTMLFB:DGBTMAL+DGBTFAB,1:0)

           SET DGBTMETC=DGBTME+$SELECT($DATA(DGBTMAL):DGBTMAL,1:0)

 +2        IF DGBTACCT'=4&(DGBTACCT'=5)

               SET DGBTPA=DGBTMAF+DGBTME

               GOTO CONT

 +3        IF $DATA(DGBTMLT)

               SET DGBTTC=$SELECT(DGBTMLT+DGBTMAF'>DGBTMETC:DGBTMLT+DGBTMAF,DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0):DGBTMETC,DGBTME'>0:DGBTMLT+DGBTMAF,1:DGBTMETC)

 +4        IF DGBTACCT=5

               SET DGBTDE=0

               SET DGBTPA=$SELECT((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC)

               GOTO CONT

 +5       ;  the following section of code moved to DGBTEE2 for space reasons

 +6        DO DED^DGBTEE2

DIE4      ;  display deductable amount

 +1        DO ^DIE

           IF X=""!(X="^")

               SET DGBTTOUT=-1

               QUIT 

CONT      ;

 +1        DO CONT^DGBTCE1

           QUIT 

EXIT      ;

 +1        KILL DGBTDV1,DGBTRMK

           QUIT