DGBTCE ;ALB/SCK - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT; 12/15/92 06/04/93
;;5.3;Registration;**5,60,69,1015**;Aug 13, 1993;Build 21
Q
SCREEN ;
D QUIT^DGBTCE1
D SCREEN^DGBTEE1 Q:'$D(^DGBT(392,DGBTDT,0)) I DGBTTOUT=-1 S DGBTTOUT=1 Q
I $D(DGBTOACT) I DGBTOACT'=DGBTACCT S DGBTVAR(0)=^DGBT(392,DGBTDT,0) D FILE
S (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDE,DGBTDCV,DGBTDCM,DGBTDPV,DGBTDPM)=0
S:$G(DGBTACCT)'>0 DGBTACCT=$P($G(DGBTVAR(0)),U,6)
S DGBTAP=VADM(1),DIE="^DGBT(392,",DA=DGBTDT,DR=$S(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44")
D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
I DGBTACCT=4!(DGBTACCT=5) S:$D(^DGBT(392,DGBTDT,"M")) DGBTWAY=$P(^("M"),"^"),DGBTMILE=$P(^("M"),"^",2) S:$D(^DGBT(392,DGBTDT,"D")) DGBTCITY=$P(^("D"),"^",4),DGBTSTAT=$P(^("D"),"^",5)
S DGBTDIV=$P($G(^DGBT(392,DA,0)),U,11),DGBTRMK=$S($D(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDIV,4),1:"")
S DIE="^DGBT(392,",DA=DGBTDT
S DR="3////"_DGBTELIG_";6////"_DGBTACTN_";21;I X="""" S Y=24;22;I X="""" S Y=24;23;24;24.1;24.2;25;I X="""" S Y=28;26;I X="""" S Y=28;27;28;28.1;28.2"
D ^DIE K DIE I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
W:DGBTRMK]"" !!,*7,"MILEAGE REMARKS: ",DGBTRMK,!
I DGBTACCT=4!(DGBTACCT=5) D Q:$G(DGBTTOUT)
. S DR="31//;S DGBTOWRT=X;32//;S DGBTML=X"
. I DGBTACCT=5&(DGBTCP=1) S DGBTMR=DGBTMR1
. S DIE="^DGBT(392,",DA=DGBTDT
. D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1
DIE1 ;
S DGBTMLT=$S($D(DGBTVAR("M"))&((DGBTACCT=4)!(DGBTACCT=5)):DGBTOWRT*DGBTML*DGBTMR,1:""),$P(^DGBT(392,DGBTDT,"M"),"^",3)=DGBTMLT,$P(DGBTVAR("M"),"^",3)=DGBTMLT
;
S DIE="^DGBT(392,",DA=DGBTDT,DR="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;8//;S DGBTME=X"
DIE3 ;
D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
;
TCOST ;CALCULATE TOTAL COST AND MONTHLY CUM. DEDUCTIBLE
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
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)) I I'=DGBTDT S DGBTDCM=DGBTDCM+($P(^DGBT(392,I,0),"^",9))
I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) S DGBTRATE=^("BT"),DGBTDPV=$P(DGBTRATE,"^"),DGBTDPM=$P(DGBTRATE,"^",2),DGBTMR=$P(DGBTRATE,"^",3)
I $D(^DGBT(392,DGBTDT,"M")) S:$P(^("M"),"^")=1 DGBTDPV=DGBTDPV/2 I DGBTWAY'=$P(^("M"),"^")!(DGBTMILE'=$P(^("M"),"^",2)) I $D(^DGBT(392,DGBTDT,0)) S $P(^(0),"^",9)="" K ^DGBT(392,"AD",$P(^(0),"^",2),$E(DGBTDT,2,5),DGBTDT)
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="I $P(^DGBT(392,DGBTDT,0),""^"",9)]"""" S Y=""@9"";9///"_DGBTDCV_";@9;9;S DGBTDE=X S:DGBTDE>DGBTTC DGBTDE=DGBTTC,DGBTFLAG=2 S:DGBTDE>DGBTDRM DGBTDE=DGBTDRM,DGBTFLAG=1"
DIE4 ;
S DIE="^DGBT(392,",DA=DGBTDT D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
CONT ;
D CONT^DGBTCE1
Q
FILE ; Reset values if account changes
S DGBTVAR(0)=$P(DGBTVAR(0),"^",1,6)_"^^0^^"_$S($L(DGBTVAR(0),"^")>10:$P(DGBTVAR(0),"^",10,$L(DGBTVAR(0),"^")),1:""),DGBTVAR("A")="^"_$P(DGBTVAR("A"),"^",2)_"^^^"_$S($L(DGBTVAR("A"),"^")>4:$P(DGBTVAR("A"),"^",5,$L(DGBTVAR("A"),"^")),1:"")
I DGBTACCT<4 S DGBTVAR("M")="^^^"_$S($L(DGBTVAR("M"),"^")>3:$P(DGBTVAR("M"),"^",4,$L(DGBTVAR("M"),"^")),1:"")
S ^DGBT(392,DGBTDT,0)=DGBTVAR(0),^("A")=DGBTVAR("A") S:DGBTACCT<4 ^("M")=DGBTVAR("M") S DA=DGBTDT,DIK="^DGBT(392," D IX^DIK
Q
DGBTCE ;ALB/SCK - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT; 12/15/92 06/04/93
+1 ;;5.3;Registration;**5,60,69,1015**;Aug 13, 1993;Build 21
+2 QUIT
SCREEN ;
+1 DO QUIT^DGBTCE1
+2 DO SCREEN^DGBTEE1
IF '$DATA(^DGBT(392,DGBTDT,0))
QUIT
IF DGBTTOUT=-1
SET DGBTTOUT=1
QUIT
+3 IF $DATA(DGBTOACT)
IF DGBTOACT'=DGBTACCT
SET DGBTVAR(0)=^DGBT(392,DGBTDT,0)
DO FILE
+4 SET (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDE,DGBTDCV,DGBTDCM,DGBTDPV,DGBTDPM)=0
+5 IF $GET(DGBTACCT)'>0
SET DGBTACCT=$PIECE($GET(DGBTVAR(0)),U,6)
+6 SET DGBTAP=VADM(1)
SET DIE="^DGBT(392,"
SET DA=DGBTDT
SET DR=$SELECT(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44")
+7 DO ^DIE
KILL DIE,DQ,DR
IF $DATA(DTOUT)!($DATA(Y))
SET DGBTTOUT=1
QUIT
+8 IF DGBTACCT=4!(DGBTACCT=5)
IF $DATA(^DGBT(392,DGBTDT,"M"))
SET DGBTWAY=$PIECE(^("M"),"^")
SET DGBTMILE=$PIECE(^("M"),"^",2)
IF $DATA(^DGBT(392,DGBTDT,"D"))
SET DGBTCITY=$PIECE(^("D"),"^",4)
SET DGBTSTAT=$PIECE(^("D"),"^",5)
+9 SET DGBTDIV=$PIECE($GET(^DGBT(392,DA,0)),U,11)
SET DGBTRMK=$SELECT($DATA(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDIV,4),1:"")
+10 SET DIE="^DGBT(392,"
SET DA=DGBTDT
+11 SET DR="3////"_DGBTELIG_";6////"_DGBTACTN_";21;I X="""" S Y=24;22;I X="""" S Y=24;23;24;24.1;24.2;25;I X="""" S Y=28;26;I X="""" S Y=28;27;28;28.1;28.2"
+12 DO ^DIE
KILL DIE
IF $DATA(DTOUT)!($DATA(Y))
SET DGBTTOUT=1
QUIT
+13 IF DGBTRMK]""
WRITE !!,*7,"MILEAGE REMARKS: ",DGBTRMK,!
+14 IF DGBTACCT=4!(DGBTACCT=5)
Begin DoDot:1
+15 SET DR="31//;S DGBTOWRT=X;32//;S DGBTML=X"
+16 IF DGBTACCT=5&(DGBTCP=1)
SET DGBTMR=DGBTMR1
+17 SET DIE="^DGBT(392,"
SET DA=DGBTDT
+18 DO ^DIE
KILL DIE,DQ,DR
IF $DATA(DTOUT)!($DATA(Y))
SET DGBTTOUT=1
End DoDot:1
IF $GET(DGBTTOUT)
QUIT
DIE1 ;
+1 SET DGBTMLT=$SELECT($DATA(DGBTVAR("M"))&((DGBTACCT=4)!(DGBTACCT=5)):DGBTOWRT*DGBTML*DGBTMR,1:"")
SET $PIECE(^DGBT(392,DGBTDT,"M"),"^",3)=DGBTMLT
SET $PIECE(DGBTVAR("M"),"^",3)=DGBTMLT
+2 ;
+3 SET DIE="^DGBT(392,"
SET DA=DGBTDT
SET DR="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;8//;S DGBTME=X"
DIE3 ;
+1 DO ^DIE
KILL DIE,DQ,DR
IF $DATA(DTOUT)!($DATA(Y))
SET DGBTTOUT=1
QUIT
+2 ;
TCOST ;CALCULATE TOTAL COST AND MONTHLY CUM. DEDUCTIBLE
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
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
IF I'=DGBTDT
SET DGBTDCM=DGBTDCM+($PIECE(^DGBT(392,I,0),"^",9))
+2 IF $DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT"))
SET DGBTRATE=^("BT")
SET DGBTDPV=$PIECE(DGBTRATE,"^")
SET DGBTDPM=$PIECE(DGBTRATE,"^",2)
SET DGBTMR=$PIECE(DGBTRATE,"^",3)
+3 IF $DATA(^DGBT(392,DGBTDT,"M"))
IF $PIECE(^("M"),"^")=1
SET DGBTDPV=DGBTDPV/2
IF DGBTWAY'=$PIECE(^("M"),"^")!(DGBTMILE'=$PIECE(^("M"),"^",2))
IF $DATA(^DGBT(392,DGBTDT,0))
SET $PIECE(^(0),"^",9)=""
KILL ^DGBT(392,"AD",$PIECE(^(0),"^",2),$EXTRACT(DGBTDT,2,5),DGBTDT)
+4 SET DGBTDRM=DGBTDPM-DGBTDCM
+5 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="I $P(^DGBT(392,DGBTDT,0),""^"",9)]"""" S Y=""@9"";9///"_DGBTDCV_";@9;9;S DGBTDE=X S:DGBTDE>DGBTTC DGBTDE=DGBTTC,DGBTFLAG=2 S:DGBTDE>DGBTDRM DGBTDE=DGBTDRM,DGBTFLAG=1"
DIE4 ;
+1 SET DIE="^DGBT(392,"
SET DA=DGBTDT
DO ^DIE
KILL DIE,DQ,DR
IF $DATA(DTOUT)!($DATA(Y))
SET DGBTTOUT=1
QUIT
CONT ;
+1 DO CONT^DGBTCE1
+2 QUIT
FILE ; Reset values if account changes
+1 SET DGBTVAR(0)=$PIECE(DGBTVAR(0),"^",1,6)_"^^0^^"_$SELECT($LENGTH(DGBTVAR(0),"^")>10:$PIECE(DGBTVAR(0),"^",10,$LENGTH(DGBTVAR(0),"^")),1:"")
SET DGBTVAR("A")="^"_$PIECE(DGBTVAR("A"),"^",2)_"^^^"_$SELECT($LENGTH(DGBTVAR("A"),"^")>4:$PIECE(DGBTVAR("A"),"^",5,$LENGTH(DGBTVAR("A"),"^")),1:"")
+2 IF DGBTACCT<4
SET DGBTVAR("M")="^^^"_$SELECT($LENGTH(DGBTVAR("M"),"^")>3:$PIECE(DGBTVAR("M"),"^",4,$LENGTH(DGBTVAR("M"),"^")),1:"")
+3 SET ^DGBT(392,DGBTDT,0)=DGBTVAR(0)
SET ^("A")=DGBTVAR("A")
IF DGBTACCT<4
SET ^("M")=DGBTVAR("M")
SET DA=DGBTDT
SET DIK="^DGBT(392,"
DO IX^DIK
+4 QUIT
