DGBTEE2.m

DGBTEE2 ;ALB/SCK BENEFICIARY TRAVEL ENTER/EDIT CONT; 03/23/93

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

START ;

 Q

STUFF ;  stuff departure=home address, destination=division(ins) address, and attendant/payee=patient        

 S DGBTFR1=VAPA(1),DGBTFR2=VAPA(2),DGBTFR3=VAPA(3),DGBTAP=VADM(1)

 ; function call $$DEPCTY passes the zip code from the patient data, and returns with the departure city name or a null.

 ; if a null for the city is returned, the city name in the patient data is defaulted to.

 S XX=$$DEPCTY^DGBTUTL($P(VAPA(11),U,1)) S X=$S(+XX>0:$P(XX,U,2),1:VAPA(4))

 D UP^DGHELP S DGBTFR4=X

 K DGBTVAR(0) S DGBTVAR(0)=$S($D(^DGBT(392,DGBTDT,0)):^(0),1:"")

 S (DGBTDIV,DGBTDV1)=$P(DGBTVAR(0),"^",11),DGBTTO1=$P(^DG(40.8,DGBTDIV,0),"^"),DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7)

 S (DGBTTO2,DGBTTO3,DGBTTO4,X)=""

 I $D(^DIC(4,DGBTDIV,1))#10=1 S DGBTTO2=$P(^DIC(4,DGBTDIV,1),"^"),DGBTTO3=$P(^(1),"^",2),X=$P(^(1),"^",3) D UP^DGHELP S DGBTTO4=X ; ref file #4, institution file by selected div

 Q

DED ;

 F I=$E(DGBTDT,1,5)_"00.2399":0 S I=$O(^DGBT(392,"C",DFN,I)) Q:'I!($E(I,1,5)>$E(DGBTDT,1,5))  S DGBTDCM=DGBTDCM+($P(^DGBT(392,I,0),"^",9))

 I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) D

 . S DGBTRATE=^("BT"),DGBTDPV=$P(DGBTRATE,"^"),DGBTDPM=$P(DGBTRATE,"^",2),DGBTMR=$P(DGBTRATE,"^",3) ; ref file #43, MAS parameters file for BT settings

 I $D(^DGBT(392,DGBTDT,"M")) I $P(^("M"),"^")=1 S DGBTDPV=DGBTDPV/2 ; ref file #392, claims file.

 S DGBTDRM=DGBTDPM-DGBTDCM

 S DGBTDCV=$S(DGBTDCM'<DGBTDPM:0,DGBTDRM'<DGBTDPV&(DGBTTC'<DGBTDPV):DGBTDPV,DGBTDRM'<DGBTDPV&(DGBTTC'>DGBTDPV):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'<DGBTDRM):DGBTDRM,1:0)

DED1 ;

 S DR="9////"_DGBTDCV_";9;S DGBTDE=X S:DGBTDE>DGBTTC DGBTDE=DGBTTC,DGBTFlAG=2 S:DGBTDE>DGBTDRM DGBTDE=DGBTDRM,DGBTFLAG=1"

 Q

RATES ;  checks parameter to ask meals & lodging, ferrys & bridges        

 S DGBTMLFB=$S($D(^DG(43,1,"BT")):$P(^DG(43,1,"BT"),"^",2),1:0)

 ;  mileage rate

 S DGBTMR=$S($D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$P(^("BT"),"^",3),1:0) ; ref file #43.1, MAS event rates file for BT rates

 S DGBTMR1=$S($D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$P(^("BT"),"^",5),1:0) ; ref file #43.1, MAS event rates file for BT rates

ELIG ;  lookup current eligibilities for patient and put into TMP list

 S DGBTCT=1,^TMP("DGBT",$J,DGBTCT)=VAEL(1)

 F I=0:0 S I=$O(VAEL(1,I)) Q:'I  S DGBTCT=DGBTCT+1,^TMP("DGBT",$J,DGBTCT)=VAEL(1,I)

 Q

ELIST ;

 W !!?5,"Primary and other entitled eligibilities for patient:",!

 I DGBTCT>1 F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I  W !?10,$P(^TMP("DGBT",$J,I),U,2)

 Q

EXIT ;

 Q

DGBTEE2   ;ALB/SCK BENEFICIARY TRAVEL ENTER/EDIT CONT; 03/23/93

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

START     ;

 +1        QUIT 

STUFF     ;  stuff departure=home address, destination=division(ins) address, and attendant/payee=patient        

 +1        SET DGBTFR1=VAPA(1)

           SET DGBTFR2=VAPA(2)

           SET DGBTFR3=VAPA(3)

           SET DGBTAP=VADM(1)

 +2       ; function call $$DEPCTY passes the zip code from the patient data, and returns with the departure city name or a null.

 +3       ; if a null for the city is returned, the city name in the patient data is defaulted to.

 +4        SET XX=$$DEPCTY^DGBTUTL($PIECE(VAPA(11),U,1))

           SET X=$SELECT(+XX>0:$PIECE(XX,U,2),1:VAPA(4))

 +5        DO UP^DGHELP

           SET DGBTFR4=X

 +6        KILL DGBTVAR(0)

           SET DGBTVAR(0)=$SELECT($DATA(^DGBT(392,DGBTDT,0)):^(0),1:"")

 +7        SET (DGBTDIV,DGBTDV1)=$PIECE(DGBTVAR(0),"^",11)

           SET DGBTTO1=$PIECE(^DG(40.8,DGBTDIV,0),"^")

           SET DGBTDIV=$PIECE(^DG(40.8,DGBTDIV,0),"^",7)

 +8        SET (DGBTTO2,DGBTTO3,DGBTTO4,X)=""

 +9       ; ref file #4, institution file by selected div

           IF $DATA(^DIC(4,DGBTDIV,1))#10=1

               SET DGBTTO2=$PIECE(^DIC(4,DGBTDIV,1),"^")

               SET DGBTTO3=$PIECE(^(1),"^",2)

               SET X=$PIECE(^(1),"^",3)

               DO UP^DGHELP

               SET DGBTTO4=X

 +10       QUIT 

DED       ;

 +1        FOR I=$EXTRACT(DGBTDT,1,5)_"00.2399":0

               SET I=$ORDER(^DGBT(392,"C",DFN,I))

               IF 'I!($EXTRACT(I,1,5)>$EXTRACT(DGBTDT,1,5))

                   QUIT 

               SET DGBTDCM=DGBTDCM+($PIECE(^DGBT(392,I,0),"^",9))

 +2        IF $DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT"))

               Begin DoDot:1

 +3       ; ref file #43, MAS parameters file for BT settings

                   SET DGBTRATE=^("BT")

                   SET DGBTDPV=$PIECE(DGBTRATE,"^")

                   SET DGBTDPM=$PIECE(DGBTRATE,"^",2)

                   SET DGBTMR=$PIECE(DGBTRATE,"^",3)

               End DoDot:1

 +4       ; ref file #392, claims file.

           IF $DATA(^DGBT(392,DGBTDT,"M"))

               IF $PIECE(^("M"),"^")=1

                   SET DGBTDPV=DGBTDPV/2

 +5        SET DGBTDRM=DGBTDPM-DGBTDCM

 +6        SET DGBTDCV=$SELECT(DGBTDCM'<DGBTDPM:0,DGBTDRM'<DGBTDPV&(DGBTTC'<DGBTDPV):DGBTDPV,DGBTDRM'<DGBTDPV&(DGBTTC'>DGBTDPV):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'<DGBTDRM):DGBTDRM,1:0)

DED1      ;

 +1        SET DR="9////"_DGBTDCV_";9;S DGBTDE=X S:DGBTDE>DGBTTC DGBTDE=DGBTTC,DGBTFlAG=2 S:DGBTDE>DGBTDRM DGBTDE=DGBTDRM,DGBTFLAG=1"

 +2        QUIT 

RATES     ;  checks parameter to ask meals & lodging, ferrys & bridges        

 +1        SET DGBTMLFB=$SELECT($DATA(^DG(43,1,"BT")):$PIECE(^DG(43,1,"BT"),"^",2),1:0)

 +2       ;  mileage rate

 +3       ; ref file #43.1, MAS event rates file for BT rates

           SET DGBTMR=$SELECT($DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$PIECE(^("BT"),"^",3),1:0)

 +4       ; ref file #43.1, MAS event rates file for BT rates

           SET DGBTMR1=$SELECT($DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$PIECE(^("BT"),"^",5),1:0)

ELIG      ;  lookup current eligibilities for patient and put into TMP list

 +1        SET DGBTCT=1

           SET ^TMP("DGBT",$JOB,DGBTCT)=VAEL(1)

 +2        FOR I=0:0

               SET I=$ORDER(VAEL(1,I))

               IF 'I

                   QUIT 

               SET DGBTCT=DGBTCT+1

               SET ^TMP("DGBT",$JOB,DGBTCT)=VAEL(1,I)

 +3        QUIT 

ELIST     ;

 +1        WRITE !!?5,"Primary and other entitled eligibilities for patient:",!

 +2        IF DGBTCT>1

               FOR I=0:0

                   SET I=$ORDER(^TMP("DGBT",$JOB,I))

                   IF 'I

                       QUIT 

                   WRITE !?10,$PIECE(^TMP("DGBT",$JOB,I),U,2)

 +3        QUIT 

EXIT      ;

 +1        QUIT