DGBTEE ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT; 12/3/92@1600 ; 7/2/14 1:17pm
;;1.0;Beneficiary Travel;**2,14,20,21,25,30,39**;September 25, 2001;Build 6
Q
SCREEN ;
;
I '$D(^DGBT(392,DGBTDT,"D"))&('$D(^DGBT(392,DGBTDT,"T"))) S DGBTSP2M=1 D STUFF^DGBTE1 K DGBTSP2M ;dbe patch DGBT*1.0*25 - added for conversion from SP to M during claim edit
D SCREEN^DGBTEE1 Q:$G(DGBTTOUT)=-1!($G(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,+DGBTADDR(5))) D ;*39 - updated to use residential address
. S X=$O(^(+DGBTADDR(5),0)) ; naked ref. refers to file #392.1, "ACS", city. Full reference on line MILES+2^DGBTEE, ^DGBTE(392.1,"ACS",DGBTFR4,+DGBTADDR(5) ;*39 - updated to use residential address
. ; 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($G(DGBTACCT)=4:"42//"_$G(DGBTAP),$G(DGBTACCT)=5:"43;S DGBTCP=X;42//"_$G(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
;
I DGBTACCT=4!(DGBTACCT=5) D
. W !!,"Please enter mileage obtained from BT Dashboard ..."
.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 ($G(DGBTACCT)=4)!($G(DGBTACCT)=5) D Q:$G(DGBTTOUT)=-1 ;20
.I $G(CHZFLG) N OTRIPTYP S OTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
.S DR="32//"_DGBTML_";S DGBTML=X;31//"_DGBTOWRT_";S DGBTOWRT=X;" D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q ;20
.I ($G(CHZFLG))&($G(OTRIPTYP)'=$$GET1^DIQ(392,DGBTDT,31,"I"))&($G(MONTOT)'="") D
..N NTRIPTYP S NTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
..I (OTRIPTYP=1)&(NTRIPTYP=2) D Q
...S $P(MONTOT,U)=$P(MONTOT,U)+1
...S $P(MONTOT,U,2)=$P(MONTOT,U,2)-1
...S $P(MONTOT,U,3)=$P(MONTOT,U,3)+1
..I (OTRIPTYP=2)&(NTRIPTYP=1) D Q
...S $P(MONTOT,U)=$P(MONTOT,U)-1
...S $P(MONTOT,U,2)=$P(MONTOT,U,2)+1
...S $P(MONTOT,U,3)=$P(MONTOT,U,3)-1
.S DGBTCCT=$$GET1^DIQ(392,DGBTDT,54,"I")
.S DIR(0)="Y",DIR("B")=$S($G(DGBTCCT)'="":"YES",1:"NO"),DIR("A")="COMMON CARRIER USED" D ^DIR K DIR I $D(DIRUT) S DGBTTOUT=-1 Q ;20
.I 'Y,$D(^DGBT(392,DGBTDT,"C")) S $P(^DGBT(392,DGBTDT,"A"),"^",4)="" F I="B","C" K ^DGBT(392,DGBTDT,I)
.I Y D ;20
..K DA,DR,DIE,Y S DIE="^DGBT(392,",DA=DGBTDT,DR="44COMMON CARRIER MODE~R" D ^DIE I $D(Y) S DGBTTOUT=-1 Q ;20
..K DA,DR,DIE,Y S DIE="^DGBT(392,",DA=DGBTDT I $$UP^XLFSTR($$GET1^DIQ(392,DGBTDT,44))["BUS" S DR="52R" D ^DIE I $D(Y) S DGBTTOUT=-1 Q ;20
..K DA,DR,DIE,Y I $$GET1^DIQ(392,DGBTDT,52)="PASS" S DIE="^DGBT(392,",DA=DGBTDT,DR="53R" D ^DIE I $D(Y) S DGBTTOUT=-1 Q ;20
..N %DT S %DT(0)="-NOW" ;prevents future dates Coder CR 53 for DG*1.0*20
..K DA,DR,DIE,Y S DIE="^DGBT(392,",DA=DGBTDT,DR="54//"_$P(DGBTDTE,"@",1)_";55;55.1" D ^DIE I $D(Y) S DGBTTOUT=-1 Q ;20 PAVEL - DGBT*1*20
S:DGBTACCT=5&(DGBTCP=1) DGBTMR=DGBTMR1 S DGBTMLT=DGBTOWRT*DGBTML*DGBTMR,DGBTMLT=$J(DGBTMLT,0,2),DR="33///"_DGBTMLT
D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q
I $G(^DGBT(392,DGBTDTI,"C"))="" K ^DGBT(392,DGBTDTI,"C"),DGBTVAR("C")
;
DIE2 ; stuff eligibility data, SC%, acct. type
;
S DIE("NO^")="12345" S:'$D(DGBTCD) DGBTCD=""
I 'DGBTCORE D
. 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//0;W:'X X S DGBTMAL=X;35//0;W:'X X S DGBTFAB=X;@2"
I DGBTCORE D
. S DR(1,392,1)="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD_";6////"_DGBTACTN_";I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;"
. S DR(1,392,2)="@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392,D0,X,$G(DGBTPRV)) S:DGBTCSL<1 Y=""@3"" W:DGBTCSL<1 "" Required"" K DGBTPRV,DGBTCSL;@1;I DGBTMLFB=0 S Y=""@2"";34//0;S DGBTMAL=X;35//0;S DGBTFAB=X;@2"
;
;DIE3 ; get most econ. cost
;
D ^DIE K DR I $G(DTOUT)!(X="^") S DGBTTOUT=-1 Q
;
;check for common carrier
S DGBTMAF=$G(DGBTFAB)+$G(DGBTMAL)
S (DGBTCC,DGBTCCAMT,DGBTCCREQ,DGBTCCMODE,DGBTMETC)=0
S DGBTDCM=$P(MONTOT,"^",4)
S DGBTDCM=$S(DGBTMLT-DGBTDCM'>0:DGBTMLT,1:DGBTDCM)
I $D(^DGBT(392,DGBTDTI,"C")) D
.S DGBTCC=$D(^DGBT(392,DGBTDTI,"C")) ;was common carrier used
.S DGBTCCAMT=$$GET1^DIQ(392,DGBTDTI,55) ; amount of common carrier
.S DGBTCCREQ=$$GET1^DIQ(392,DGBTDTI,55.1),DGBTCCREQ=$S(DGBTCCREQ="YES":1,1:0) ;common carrier required - 1=yes,0=no
.S DGBTCCMODE=$$GET1^DIQ(392,DGBTDTI,44,"I") ;common carrier mode of transportation
.S DGBTMETC=$G(DGBTME)+$G(DGBTMAL) ;$S($D(DGBTMAL):DGBTMAL,1:0) ;most enco + meals and lodging S DGBTDCM=$P(MONTOT,"^",4) S DGBTDCM=$P(MONTOT,"^",4) S DGBTMAF=$S(DGBTMLFB:DGBTMAL+DGBTFAB,1:0),DGBTMETC=DGBTME+$S($D(DGBTMAL):DGBTMAL,1:0)
;
;if CC not required reset most econ to 0
I $G(DGBTCCREQ) D
.S FDA(392,DGBTDTI_",",8)=0
.D FILE^DIE(,"FDA")
S:$D(DGBTREC) DGBTME=$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,3) S:DGBTME="" DGBTME=0 S DR="8//"_DGBTME_";W:'X X S DGBTME=X" D ^DIE I X=""!(X="^") S DGBTTOUT=-1 G EXIT
TCOST ; calculate total cost and monthly cum. deductible
MLFB ;
;
N OWAIV
S OWAIV=$P(MONTOT,U,5)
S MONTOT=$$ADDTO(.MONTOT)
I DGBTACCT'=4&(DGBTACCT'=5) S DGBTPA=DGBTMAF+DGBTME G CONT
I $D(DGBTMLT) D
.I DGBTMLT+DGBTMAF'>DGBTMETC S DGBTTC=DGBTMLT+DGBTMAF Q
.I DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0) S DGBTTC=DGBTMETC Q
.I DGBTME'>0 S DGBTTC=DGBTMLT+DGBTMAF Q
.E S DGBTTC=DGBTMETC
I $G(DGBTCCREQ) S DGBTTC=$G(DGBTTC)+DGBTCCAMT
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
I DGBTACCT'=5 D
.N DGBTDCVX,XY
.I $G(CHZFLG) N ODED S ODED=$$GET1^DIQ(392,DGBTDT,9)
.D DED^DGBTEE2
.I $P($G(MONTOT),"^",5)'["Y" S DGBTDCV=DGBTDCV1
.;add by Pavel for patch 20
.I $G(DGBTCC),$G(DGBTCCREQ),'$G(DGBTMLT) S DGBTDCV=0
.I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTMLT)'>0 S DGBTDCV=0
.I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTME)'>0
.I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTME)>0,$G(DGBTME)'>$G(DGBTMLT) S DGBTDCV=0
.I $G(DGBTCC),$G(DGBTCCREQ),$G(DGBTDE)'<$G(DGBTMLT) S DGBTDE=DGBTMLT
.I '$G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTMLT)'>0 S DGBTDCV=0
.I '$G(DGBTCC),DGBTMLT>DGBTDPV S (DGBTDCV,DGBTDE)=DGBTDPV
.I ($G(CHZFLG))&($$GET1^DIQ(392,DGBTDT,9)=0)&($P($G(MONTOT),U,5)["Y") S (DGBTDCV,DGBTE)=0
.;dbe patch DGBT*1.0*25 - modified the next line to use the total deductible for the month, MONTOT piece 4
.I (+$P($G(MONTOT),U,4)<18)&((+$P($G(MONTOT),U,4)+DGBTDCV)>18)&(OWAIV'["Y")&('$G(CHZFLG)) S DGBTDCV=18-$P(MONTOT,U,4),$P(MONTOT,U,5)="NO" ; RFE 12/5/12
.I (+$G(CHZFLG)&(($P($G(MONTOT),U,7)+DGBTDCV)>18)) S DGBTDCV=18-$P(MONTOT,U,7),$P(MONTOT,U,5)="NO" ; RFE 12/5/12 ;*30
.I (+$P($G(MONTOT),U,1)>6)!(+$P($G(MONTOT),U,4)>18)!($P($G(MONTOT),U,5)["Y")&('$G(CHZFLG)) S DGBTDCV=0 ; Added ELSE RFE 12/5/12
.I $$DENIED(DGBTDT) S DGBTDCV=0
.I $G(CHZFLG)=0 S ($P(MONTOT,U,4),$P(MONTOT,U,7))=$P(MONTOT,U,4)+DGBTDCV
.S DGBTOTHER=$$GET1^DIQ(392,DGBTDT,43.1,"I")
.I $G(DGBTNSC) S DGBTDCV=0
.I $G(DGBTOTHER)=11 S DGBTDCV=0
.I $G(DGBTOTHER)=12 S DGBTDCV=0
.I $G(DGBTOTHER)=13 S DGBTDCV=0
.S XY=$S(DGBTDCV>99:"99.00",1:DGBTDCV)
.N FDA
.S FDA(392,DGBTDT_",",9)=XY ;Input transform for field 9 is set to max 99
.S FDA(392,DGBTDT_",",56)="M"
.D FILE^DIE(,"FDA")
.W !,"DEDUCTIBLE AMOUNT: "_DGBTDCV_"// "_XY ;," ",$S($G(DGBTREF):"",1:$G(DGBTDCVX))
.S DGBTDCV=XY
.S DGBTDE=DGBTDCV
.I ($G(CHZFLG))&($G(ODED)'=DGBTDE)&($G(MONTOT)'="") D
..S $P(MONTOT,U,4)=$P(MONTOT,U,4)+DGBTDE
..S $P(MONTOT,U,4)=$P(MONTOT,U,4)-ODED
CONT ;
D CONT^DGBTCE1 Q
EXIT ;
K DGBTDV1,DGBTRMK Q
;
DENIED(DGBTDT) ;check for a denied claim
;
N DENIED
S DENIED=$$GET1^DIQ(392,DGBTDT,45.2,"I")
;
Q DENIED
ADDTO(MONTOT) ;this will add the current trip to the total trips for the month.
;
N TRIPTYP
I CHZFLG=1 Q MONTOT
I $D(^DGBT(392,DGBTDT,"M")),$P(^("M"),"^")=1 S TRIPTYP=1
E S TRIPTYP=2
I TRIPTYP=1 S $P(MONTOT,"^",1)=$P(MONTOT,"^",1)+1
I TRIPTYP=2 S $P(MONTOT,"^",1)=$S($P(MONTOT,"^",1)<6:$P(MONTOT,"^",1)+1,1:$P(MONTOT,"^",1)+2)
;S $P(MONTOT,"^",1)=$S(TRIPTYP=1:$P(MONTOT,"^",1)+1,1:$P(MONTOT,"^",1)+2) ;add current trip to total for month
I TRIPTYP=1 S $P(MONTOT,U,2)=$P(MONTOT,U,2)+1
I TRIPTYP=2 S $P(MONTOT,U,3)=$P(MONTOT,U,3)+1
S $P(MONTOT,"^",6)=$S(TRIPTYP=1:$P(MONTOT,"^",6)+1,1:$P(MONTOT,"^",6)+2)
I ($P(MONTOT,U,5)'["Y")&($P(MONTOT,U)>6) S $P(MONTOT,U,5)="YES"
I ($P(MONTOT,U,5)'["Y")&($P(MONTOT,U,2)>18) S $P(MONTOT,U,5)="YES"
Q MONTOT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTEE 9291 printed Oct 16, 2024@17:41:32 Page 2
DGBTEE ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT; 12/3/92@1600 ; 7/2/14 1:17pm
+1 ;;1.0;Beneficiary Travel;**2,14,20,21,25,30,39**;September 25, 2001;Build 6
+2 QUIT
SCREEN ;
+1 ;
+2 ;dbe patch DGBT*1.0*25 - added for conversion from SP to M during claim edit
IF '$DATA(^DGBT(392,DGBTDT,"D"))&('$DATA(^DGBT(392,DGBTDT,"T")))
SET DGBTSP2M=1
DO STUFF^DGBTE1
KILL DGBTSP2M
+3 DO SCREEN^DGBTEE1
if $GET(DGBTTOUT)=-1!($GET(DGBTTOUT)=1)
QUIT
if '$DATA(^DGBT(392,DGBTDT,0))
QUIT
+4 ; The following section of code moved to DGBTEE2 for space problems
+5 DO STUFF^DGBTEE2
MILES ; get miles between dep. and dest. using function call to DGBTUTL
+1 ;
+2 KILL X,DGBTREC
SET (DGBTOWRT,DGBTML,DGBTMLT)=""
+3 ;*39 - updated to use residential address
IF DGBTFR4]""&((DGBTACCT=4)!(DGBTACCT=5))
IF $DATA(^DGBT(392.1,"ACS",DGBTFR4,+DGBTADDR(5)))
Begin DoDot:1
+4 ; naked ref. refers to file #392.1, "ACS", city. Full reference on line MILES+2^DGBTEE, ^DGBTE(392.1,"ACS",DGBTFR4,+DGBTADDR(5) ;*39 - updated to use residential address
SET X=$ORDER(^(+DGBTADDR(5),0))
+5 ; function $$miles passes city's record# and div name to function, mileage value is returned
+6 IF X'=""
SET DGBTREC=X
SET DGBTML=$$MILES^DGBTUTL(DGBTREC,DGBTDV1)
SET DGBTOWRT="ROUND TRIP"
KILL X
End DoDot:1
+7 SET (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDCV,DGBTDE,DGBTDCM,DGBTDPV,DGBTDPM)=0
DIE1 ; stuff from,to address, meals, ferry's/bridges
+1 ;
+2 if '$DATA(^DGBT(392,DGBTDT,0))
QUIT
+3 ;
+4 SET DIE="^DGBT(392,"
SET DA=DGBTDT
SET DR=$SELECT($GET(DGBTACCT)=4:"42//"_$GET(DGBTAP),$GET(DGBTACCT)=5:"43;S DGBTCP=X;42//"_$GET(DGBTAP),1:"44")
+5 DO ^DIE
IF X=""!(X="^")
SET DGBTTOUT=-1
QUIT
+6 ;
+7 ;;34////^S X=DGBTMAL;35////^S X=DGBTFAB"
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"
+8 DO ^DIE
IF X=""!(X="^")
SET DGBTTOUT=-1
QUIT
+9 ;
+10 IF DGBTACCT=4!(DGBTACCT=5)
Begin DoDot:1
+11 WRITE !!,"Please enter mileage obtained from BT Dashboard ..."
+12 SET DGBTRMK=$SELECT($DATA(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,4),1:"")
IF $DATA(DGBTDEF)
IF DGBTDEF
SET DGBTRMK="DEFAULT MILEAGE USED"
+13 IF DGBTRMK]""
WRITE !,*7,"MILEAGE REMARKS: ",DGBTRMK,!
End DoDot:1
+14 ;
EDIT ; display trip type, mileage
+1 ;20
IF ($GET(DGBTACCT)=4)!($GET(DGBTACCT)=5)
Begin DoDot:1
+2 IF $GET(CHZFLG)
NEW OTRIPTYP
SET OTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
+3 ;20
SET DR="32//"_DGBTML_";S DGBTML=X;31//"_DGBTOWRT_";S DGBTOWRT=X;"
DO ^DIE
IF X=""!(X="^")
SET DGBTTOUT=-1
QUIT
+4 IF ($GET(CHZFLG))&($GET(OTRIPTYP)'=$$GET1^DIQ(392,DGBTDT,31,"I"))&($GET(MONTOT)'="")
Begin DoDot:2
+5 NEW NTRIPTYP
SET NTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
+6 IF (OTRIPTYP=1)&(NTRIPTYP=2)
Begin DoDot:3
+7 SET $PIECE(MONTOT,U)=$PIECE(MONTOT,U)+1
+8 SET $PIECE(MONTOT,U,2)=$PIECE(MONTOT,U,2)-1
+9 SET $PIECE(MONTOT,U,3)=$PIECE(MONTOT,U,3)+1
End DoDot:3
QUIT
+10 IF (OTRIPTYP=2)&(NTRIPTYP=1)
Begin DoDot:3
+11 SET $PIECE(MONTOT,U)=$PIECE(MONTOT,U)-1
+12 SET $PIECE(MONTOT,U,2)=$PIECE(MONTOT,U,2)+1
+13 SET $PIECE(MONTOT,U,3)=$PIECE(MONTOT,U,3)-1
End DoDot:3
QUIT
End DoDot:2
+14 SET DGBTCCT=$$GET1^DIQ(392,DGBTDT,54,"I")
+15 ;20
SET DIR(0)="Y"
SET DIR("B")=$SELECT($GET(DGBTCCT)'="":"YES",1:"NO")
SET DIR("A")="COMMON CARRIER USED"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET DGBTTOUT=-1
QUIT
+16 IF 'Y
IF $DATA(^DGBT(392,DGBTDT,"C"))
SET $PIECE(^DGBT(392,DGBTDT,"A"),"^",4)=""
FOR I="B","C"
KILL ^DGBT(392,DGBTDT,I)
+17 ;20
IF Y
Begin DoDot:2
+18 ;20
KILL DA,DR,DIE,Y
SET DIE="^DGBT(392,"
SET DA=DGBTDT
SET DR="44COMMON CARRIER MODE~R"
DO ^DIE
IF $DATA(Y)
SET DGBTTOUT=-1
QUIT
+19 ;20
KILL DA,DR,DIE,Y
SET DIE="^DGBT(392,"
SET DA=DGBTDT
IF $$UP^XLFSTR($$GET1^DIQ(392,DGBTDT,44))["BUS"
SET DR="52R"
DO ^DIE
IF $DATA(Y)
SET DGBTTOUT=-1
QUIT
+20 ;20
KILL DA,DR,DIE,Y
IF $$GET1^DIQ(392,DGBTDT,52)="PASS"
SET DIE="^DGBT(392,"
SET DA=DGBTDT
SET DR="53R"
DO ^DIE
IF $DATA(Y)
SET DGBTTOUT=-1
QUIT
+21 ;prevents future dates Coder CR 53 for DG*1.0*20
NEW %DT
SET %DT(0)="-NOW"
+22 ;20 PAVEL - DGBT*1*20
KILL DA,DR,DIE,Y
SET DIE="^DGBT(392,"
SET DA=DGBTDT
SET DR="54//"_$PIECE(DGBTDTE,"@",1)_";55;55.1"
DO ^DIE
IF $DATA(Y)
SET DGBTTOUT=-1
QUIT
End DoDot:2
End DoDot:1
if $GET(DGBTTOUT)=-1
QUIT
+23 if DGBTACCT=5&(DGBTCP=1)
SET DGBTMR=DGBTMR1
SET DGBTMLT=DGBTOWRT*DGBTML*DGBTMR
SET DGBTMLT=$JUSTIFY(DGBTMLT,0,2)
SET DR="33///"_DGBTMLT
+24 DO ^DIE
IF X=""!(X="^")
SET DGBTTOUT=-1
QUIT
+25 IF $GET(^DGBT(392,DGBTDTI,"C"))=""
KILL ^DGBT(392,DGBTDTI,"C"),DGBTVAR("C")
+26 ;
DIE2 ; stuff eligibility data, SC%, acct. type
+1 ;
+2 SET DIE("NO^")="12345"
if '$DATA(DGBTCD)
SET DGBTCD=""
+3 IF 'DGBTCORE
Begin DoDot:1
+4 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//0;W:'X X S DGBTMAL=X;35//0;W:'X X S DGBTFAB=X;@2"
End DoDot:1
+5 IF DGBTCORE
Begin DoDot:1
+6 SET DR(1,392,1)="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD_";6////"_DGBTACTN_";I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;"
+7 SET DR(1,392,2)="@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392,D0,X,$G(DGBTPRV)) S:DGBTCSL<1 Y=""@3"" W:DGBTCSL<1 "" Required"" K DGBTPRV,DGBTCSL;@1;I DGBTMLFB=0 S Y=""@2"";34//0;S DGBTMAL=X;35//0;S DGBTFAB=X;@2"
End DoDot:1
+8 ;
+9 ;DIE3 ; get most econ. cost
+10 ;
+11 DO ^DIE
KILL DR
IF $GET(DTOUT)!(X="^")
SET DGBTTOUT=-1
QUIT
+12 ;
+13 ;check for common carrier
+14 SET DGBTMAF=$GET(DGBTFAB)+$GET(DGBTMAL)
+15 SET (DGBTCC,DGBTCCAMT,DGBTCCREQ,DGBTCCMODE,DGBTMETC)=0
+16 SET DGBTDCM=$PIECE(MONTOT,"^",4)
+17 SET DGBTDCM=$SELECT(DGBTMLT-DGBTDCM'>0:DGBTMLT,1:DGBTDCM)
+18 IF $DATA(^DGBT(392,DGBTDTI,"C"))
Begin DoDot:1
+19 ;was common carrier used
SET DGBTCC=$DATA(^DGBT(392,DGBTDTI,"C"))
+20 ; amount of common carrier
SET DGBTCCAMT=$$GET1^DIQ(392,DGBTDTI,55)
+21 ;common carrier required - 1=yes,0=no
SET DGBTCCREQ=$$GET1^DIQ(392,DGBTDTI,55.1)
SET DGBTCCREQ=$SELECT(DGBTCCREQ="YES":1,1:0)
+22 ;common carrier mode of transportation
SET DGBTCCMODE=$$GET1^DIQ(392,DGBTDTI,44,"I")
+23 ;$S($D(DGBTMAL):DGBTMAL,1:0) ;most enco + meals and lodging S DGBTDCM=$P(MONTOT,"^",4) S DGBTDCM=$P(MONTOT,"^",4) S DGBTMAF=$S(DGBTMLFB:DGBTMAL+DGBTFAB,1:0),DGBTMETC=DGBTME+$S($D(DGBTMAL):DGBTMAL,1:0)
SET DGBTMETC=$GET(DGBTME)+$GET(DGBTMAL)
End DoDot:1
+24 ;
+25 ;if CC not required reset most econ to 0
+26 IF $GET(DGBTCCREQ)
Begin DoDot:1
+27 SET FDA(392,DGBTDTI_",",8)=0
+28 DO FILE^DIE(,"FDA")
End DoDot:1
+29 if $DATA(DGBTREC)
SET DGBTME=$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,3)
if DGBTME=""
SET DGBTME=0
SET DR="8//"_DGBTME_";W:'X X S DGBTME=X"
DO ^DIE
IF X=""!(X="^")
SET DGBTTOUT=-1
GOTO EXIT
TCOST ; calculate total cost and monthly cum. deductible
MLFB ;
+1 ;
+2 NEW OWAIV
+3 SET OWAIV=$PIECE(MONTOT,U,5)
+4 SET MONTOT=$$ADDTO(.MONTOT)
+5 IF DGBTACCT'=4&(DGBTACCT'=5)
SET DGBTPA=DGBTMAF+DGBTME
GOTO CONT
+6 IF $DATA(DGBTMLT)
Begin DoDot:1
+7 IF DGBTMLT+DGBTMAF'>DGBTMETC
SET DGBTTC=DGBTMLT+DGBTMAF
QUIT
+8 IF DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0)
SET DGBTTC=DGBTMETC
QUIT
+9 IF DGBTME'>0
SET DGBTTC=DGBTMLT+DGBTMAF
QUIT
+10 IF '$TEST
SET DGBTTC=DGBTMETC
End DoDot:1
+11 IF $GET(DGBTCCREQ)
SET DGBTTC=$GET(DGBTTC)+DGBTCCAMT
+12 ;G CONT
IF DGBTACCT=5
SET DGBTDE=0
SET DGBTPA=$SELECT((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC)
+13 ; the following section of code moved to DGBTEE2 for space reasons
+14 IF DGBTACCT'=5
Begin DoDot:1
+15 NEW DGBTDCVX,XY
+16 IF $GET(CHZFLG)
NEW ODED
SET ODED=$$GET1^DIQ(392,DGBTDT,9)
+17 DO DED^DGBTEE2
+18 IF $PIECE($GET(MONTOT),"^",5)'["Y"
SET DGBTDCV=DGBTDCV1
+19 ;add by Pavel for patch 20
+20 IF $GET(DGBTCC)
IF $GET(DGBTCCREQ)
IF '$GET(DGBTMLT)
SET DGBTDCV=0
+21 IF $GET(DGBTCC)
IF '$GET(DGBTCCREQ)
IF $GET(DGBTMLT)'>0
SET DGBTDCV=0
+22 IF $GET(DGBTCC)
IF '$GET(DGBTCCREQ)
IF $GET(DGBTME)'>0
+23 IF $GET(DGBTCC)
IF '$GET(DGBTCCREQ)
IF $GET(DGBTME)>0
IF $GET(DGBTME)'>$GET(DGBTMLT)
SET DGBTDCV=0
+24 IF $GET(DGBTCC)
IF $GET(DGBTCCREQ)
IF $GET(DGBTDE)'<$GET(DGBTMLT)
SET DGBTDE=DGBTMLT
+25 IF '$GET(DGBTCC)
IF '$GET(DGBTCCREQ)
IF $GET(DGBTMLT)'>0
SET DGBTDCV=0
+26 IF '$GET(DGBTCC)
IF DGBTMLT>DGBTDPV
SET (DGBTDCV,DGBTDE)=DGBTDPV
+27 IF ($GET(CHZFLG))&($$GET1^DIQ(392,DGBTDT,9)=0)&($PIECE($GET(MONTOT),U,5)["Y")
SET (DGBTDCV,DGBTE)=0
+28 ;dbe patch DGBT*1.0*25 - modified the next line to use the total deductible for the month, MONTOT piece 4
+29 ; RFE 12/5/12
IF (+$PIECE($GET(MONTOT),U,4)<18)&((+$PIECE($GET(MONTOT),U,4)+DGBTDCV)>18)&(OWAIV'["Y")&('$GET(CHZFLG))
SET DGBTDCV=18-$PIECE(MONTOT,U,4)
SET $PIECE(MONTOT,U,5)="NO"
+30 ; RFE 12/5/12 ;*30
IF (+$GET(CHZFLG)&(($PIECE($GET(MONTOT),U,7)+DGBTDCV)>18))
SET DGBTDCV=18-$PIECE(MONTOT,U,7)
SET $PIECE(MONTOT,U,5)="NO"
+31 ; Added ELSE RFE 12/5/12
IF (+$PIECE($GET(MONTOT),U,1)>6)!(+$PIECE($GET(MONTOT),U,4)>18)!($PIECE($GET(MONTOT),U,5)["Y")&('$GET(CHZFLG))
SET DGBTDCV=0
+32 IF $$DENIED(DGBTDT)
SET DGBTDCV=0
+33 IF $GET(CHZFLG)=0
SET ($PIECE(MONTOT,U,4),$PIECE(MONTOT,U,7))=$PIECE(MONTOT,U,4)+DGBTDCV
+34 SET DGBTOTHER=$$GET1^DIQ(392,DGBTDT,43.1,"I")
+35 IF $GET(DGBTNSC)
SET DGBTDCV=0
+36 IF $GET(DGBTOTHER)=11
SET DGBTDCV=0
+37 IF $GET(DGBTOTHER)=12
SET DGBTDCV=0
+38 IF $GET(DGBTOTHER)=13
SET DGBTDCV=0
+39 SET XY=$SELECT(DGBTDCV>99:"99.00",1:DGBTDCV)
+40 NEW FDA
+41 ;Input transform for field 9 is set to max 99
SET FDA(392,DGBTDT_",",9)=XY
+42 SET FDA(392,DGBTDT_",",56)="M"
+43 DO FILE^DIE(,"FDA")
+44 ;," ",$S($G(DGBTREF):"",1:$G(DGBTDCVX))
WRITE !,"DEDUCTIBLE AMOUNT: "_DGBTDCV_"// "_XY
+45 SET DGBTDCV=XY
+46 SET DGBTDE=DGBTDCV
+47 IF ($GET(CHZFLG))&($GET(ODED)'=DGBTDE)&($GET(MONTOT)'="")
Begin DoDot:2
+48 SET $PIECE(MONTOT,U,4)=$PIECE(MONTOT,U,4)+DGBTDE
+49 SET $PIECE(MONTOT,U,4)=$PIECE(MONTOT,U,4)-ODED
End DoDot:2
End DoDot:1
CONT ;
+1 DO CONT^DGBTCE1
QUIT
EXIT ;
+1 KILL DGBTDV1,DGBTRMK
QUIT
+2 ;
DENIED(DGBTDT) ;check for a denied claim
+1 ;
+2 NEW DENIED
+3 SET DENIED=$$GET1^DIQ(392,DGBTDT,45.2,"I")
+4 ;
+5 QUIT DENIED
ADDTO(MONTOT) ;this will add the current trip to the total trips for the month.
+1 ;
+2 NEW TRIPTYP
+3 IF CHZFLG=1
QUIT MONTOT
+4 IF $DATA(^DGBT(392,DGBTDT,"M"))
IF $PIECE(^("M"),"^")=1
SET TRIPTYP=1
+5 IF '$TEST
SET TRIPTYP=2
+6 IF TRIPTYP=1
SET $PIECE(MONTOT,"^",1)=$PIECE(MONTOT,"^",1)+1
+7 IF TRIPTYP=2
SET $PIECE(MONTOT,"^",1)=$SELECT($PIECE(MONTOT,"^",1)<6:$PIECE(MONTOT,"^",1)+1,1:$PIECE(MONTOT,"^",1)+2)
+8 ;S $P(MONTOT,"^",1)=$S(TRIPTYP=1:$P(MONTOT,"^",1)+1,1:$P(MONTOT,"^",1)+2) ;add current trip to total for month
+9 IF TRIPTYP=1
SET $PIECE(MONTOT,U,2)=$PIECE(MONTOT,U,2)+1
+10 IF TRIPTYP=2
SET $PIECE(MONTOT,U,3)=$PIECE(MONTOT,U,3)+1
+11 SET $PIECE(MONTOT,"^",6)=$SELECT(TRIPTYP=1:$PIECE(MONTOT,"^",6)+1,1:$PIECE(MONTOT,"^",6)+2)
+12 IF ($PIECE(MONTOT,U,5)'["Y")&($PIECE(MONTOT,U)>6)
SET $PIECE(MONTOT,U,5)="YES"
+13 IF ($PIECE(MONTOT,U,5)'["Y")&($PIECE(MONTOT,U,2)>18)
SET $PIECE(MONTOT,U,5)="YES"
+14 QUIT MONTOT
+15 ;
