Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGBTEE

DGBTEE.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. SCREEN ;
  1. ;
  1. 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
  1. D SCREEN^DGBTEE1 Q:$G(DGBTTOUT)=-1!($G(DGBTTOUT)=1) Q:'$D(^DGBT(392,DGBTDT,0))
  1. ; The following section of code moved to DGBTEE2 for space problems
  1. D STUFF^DGBTEE2
  1. MILES ; get miles between dep. and dest. using function call to DGBTUTL
  1. ;
  1. K X,DGBTREC S (DGBTOWRT,DGBTML,DGBTMLT)=""
  1. I DGBTFR4]""&((DGBTACCT=4)!(DGBTACCT=5)) I $D(^DGBT(392.1,"ACS",DGBTFR4,+DGBTADDR(5))) D ;*39 - updated to use residential address
  1. . 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
  1. . ; function $$miles passes city's record# and div name to function, mileage value is returned
  1. . I X'="" S DGBTREC=X,DGBTML=$$MILES^DGBTUTL(DGBTREC,DGBTDV1),DGBTOWRT="ROUND TRIP" K X
  1. S (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDCV,DGBTDE,DGBTDCM,DGBTDPV,DGBTDPM)=0
  1. DIE1 ; stuff from,to address, meals, ferry's/bridges
  1. ;
  1. Q:'$D(^DGBT(392,DGBTDT,0))
  1. ;
  1. 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")
  1. D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q
  1. ;
  1. 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"
  1. D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q
  1. ;
  1. I DGBTACCT=4!(DGBTACCT=5) D
  1. . W !!,"Please enter mileage obtained from BT Dashboard ..."
  1. .S DGBTRMK=$S($D(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,4),1:"") I $D(DGBTDEF),DGBTDEF S DGBTRMK="DEFAULT MILEAGE USED"
  1. .I DGBTRMK]"" W !,*7,"MILEAGE REMARKS: ",DGBTRMK,!
  1. ;
  1. EDIT ; display trip type, mileage
  1. I ($G(DGBTACCT)=4)!($G(DGBTACCT)=5) D Q:$G(DGBTTOUT)=-1 ;20
  1. .I $G(CHZFLG) N OTRIPTYP S OTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
  1. .S DR="32//"_DGBTML_";S DGBTML=X;31//"_DGBTOWRT_";S DGBTOWRT=X;" D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q ;20
  1. .I ($G(CHZFLG))&($G(OTRIPTYP)'=$$GET1^DIQ(392,DGBTDT,31,"I"))&($G(MONTOT)'="") D
  1. ..N NTRIPTYP S NTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
  1. ..I (OTRIPTYP=1)&(NTRIPTYP=2) D Q
  1. ...S $P(MONTOT,U)=$P(MONTOT,U)+1
  1. ...S $P(MONTOT,U,2)=$P(MONTOT,U,2)-1
  1. ...S $P(MONTOT,U,3)=$P(MONTOT,U,3)+1
  1. ..I (OTRIPTYP=2)&(NTRIPTYP=1) D Q
  1. ...S $P(MONTOT,U)=$P(MONTOT,U)-1
  1. ...S $P(MONTOT,U,2)=$P(MONTOT,U,2)+1
  1. ...S $P(MONTOT,U,3)=$P(MONTOT,U,3)-1
  1. .S DGBTCCT=$$GET1^DIQ(392,DGBTDT,54,"I")
  1. .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
  1. .I 'Y,$D(^DGBT(392,DGBTDT,"C")) S $P(^DGBT(392,DGBTDT,"A"),"^",4)="" F I="B","C" K ^DGBT(392,DGBTDT,I)
  1. .I Y D ;20
  1. ..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
  1. ..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
  1. ..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
  1. ..N %DT S %DT(0)="-NOW" ;prevents future dates Coder CR 53 for DG*1.0*20
  1. ..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
  1. S:DGBTACCT=5&(DGBTCP=1) DGBTMR=DGBTMR1 S DGBTMLT=DGBTOWRT*DGBTML*DGBTMR,DGBTMLT=$J(DGBTMLT,0,2),DR="33///"_DGBTMLT
  1. D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q
  1. I $G(^DGBT(392,DGBTDTI,"C"))="" K ^DGBT(392,DGBTDTI,"C"),DGBTVAR("C")
  1. ;
  1. DIE2 ; stuff eligibility data, SC%, acct. type
  1. ;
  1. S DIE("NO^")="12345" S:'$D(DGBTCD) DGBTCD=""
  1. I 'DGBTCORE D
  1. . 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"
  1. I DGBTCORE D
  1. . S DR(1,392,1)="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD_";6////"_DGBTACTN_";I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;"
  1. . 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"
  1. ;
  1. ;DIE3 ; get most econ. cost
  1. ;
  1. D ^DIE K DR I $G(DTOUT)!(X="^") S DGBTTOUT=-1 Q
  1. ;
  1. ;check for common carrier
  1. S DGBTMAF=$G(DGBTFAB)+$G(DGBTMAL)
  1. S (DGBTCC,DGBTCCAMT,DGBTCCREQ,DGBTCCMODE,DGBTMETC)=0
  1. S DGBTDCM=$P(MONTOT,"^",4)
  1. S DGBTDCM=$S(DGBTMLT-DGBTDCM'>0:DGBTMLT,1:DGBTDCM)
  1. I $D(^DGBT(392,DGBTDTI,"C")) D
  1. .S DGBTCC=$D(^DGBT(392,DGBTDTI,"C")) ;was common carrier used
  1. .S DGBTCCAMT=$$GET1^DIQ(392,DGBTDTI,55) ; amount of common carrier
  1. .S DGBTCCREQ=$$GET1^DIQ(392,DGBTDTI,55.1),DGBTCCREQ=$S(DGBTCCREQ="YES":1,1:0) ;common carrier required - 1=yes,0=no
  1. .S DGBTCCMODE=$$GET1^DIQ(392,DGBTDTI,44,"I") ;common carrier mode of transportation
  1. .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)
  1. ;
  1. ;if CC not required reset most econ to 0
  1. I $G(DGBTCCREQ) D
  1. .S FDA(392,DGBTDTI_",",8)=0
  1. .D FILE^DIE(,"FDA")
  1. 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
  1. TCOST ; calculate total cost and monthly cum. deductible
  1. MLFB ;
  1. ;
  1. N OWAIV
  1. S OWAIV=$P(MONTOT,U,5)
  1. S MONTOT=$$ADDTO(.MONTOT)
  1. I DGBTACCT'=4&(DGBTACCT'=5) S DGBTPA=DGBTMAF+DGBTME G CONT
  1. I $D(DGBTMLT) D
  1. .I DGBTMLT+DGBTMAF'>DGBTMETC S DGBTTC=DGBTMLT+DGBTMAF Q
  1. .I DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0) S DGBTTC=DGBTMETC Q
  1. .I DGBTME'>0 S DGBTTC=DGBTMLT+DGBTMAF Q
  1. .E S DGBTTC=DGBTMETC
  1. I $G(DGBTCCREQ) S DGBTTC=$G(DGBTTC)+DGBTCCAMT
  1. I DGBTACCT=5 S DGBTDE=0 S DGBTPA=$S((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC) ;G CONT
  1. ; the following section of code moved to DGBTEE2 for space reasons
  1. I DGBTACCT'=5 D
  1. .N DGBTDCVX,XY
  1. .I $G(CHZFLG) N ODED S ODED=$$GET1^DIQ(392,DGBTDT,9)
  1. .D DED^DGBTEE2
  1. .I $P($G(MONTOT),"^",5)'["Y" S DGBTDCV=DGBTDCV1
  1. .;add by Pavel for patch 20
  1. .I $G(DGBTCC),$G(DGBTCCREQ),'$G(DGBTMLT) S DGBTDCV=0
  1. .I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTMLT)'>0 S DGBTDCV=0
  1. .I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTME)'>0
  1. .I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTME)>0,$G(DGBTME)'>$G(DGBTMLT) S DGBTDCV=0
  1. .I $G(DGBTCC),$G(DGBTCCREQ),$G(DGBTDE)'<$G(DGBTMLT) S DGBTDE=DGBTMLT
  1. .I '$G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTMLT)'>0 S DGBTDCV=0
  1. .I '$G(DGBTCC),DGBTMLT>DGBTDPV S (DGBTDCV,DGBTDE)=DGBTDPV
  1. .I ($G(CHZFLG))&($$GET1^DIQ(392,DGBTDT,9)=0)&($P($G(MONTOT),U,5)["Y") S (DGBTDCV,DGBTE)=0
  1. .;dbe patch DGBT*1.0*25 - modified the next line to use the total deductible for the month, MONTOT piece 4
  1. .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
  1. .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
  1. .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
  1. .I $$DENIED(DGBTDT) S DGBTDCV=0
  1. .I $G(CHZFLG)=0 S ($P(MONTOT,U,4),$P(MONTOT,U,7))=$P(MONTOT,U,4)+DGBTDCV
  1. .S DGBTOTHER=$$GET1^DIQ(392,DGBTDT,43.1,"I")
  1. .I $G(DGBTNSC) S DGBTDCV=0
  1. .I $G(DGBTOTHER)=11 S DGBTDCV=0
  1. .I $G(DGBTOTHER)=12 S DGBTDCV=0
  1. .I $G(DGBTOTHER)=13 S DGBTDCV=0
  1. .S XY=$S(DGBTDCV>99:"99.00",1:DGBTDCV)
  1. .N FDA
  1. .S FDA(392,DGBTDT_",",9)=XY ;Input transform for field 9 is set to max 99
  1. .S FDA(392,DGBTDT_",",56)="M"
  1. .D FILE^DIE(,"FDA")
  1. .W !,"DEDUCTIBLE AMOUNT: "_DGBTDCV_"// "_XY ;," ",$S($G(DGBTREF):"",1:$G(DGBTDCVX))
  1. .S DGBTDCV=XY
  1. .S DGBTDE=DGBTDCV
  1. .I ($G(CHZFLG))&($G(ODED)'=DGBTDE)&($G(MONTOT)'="") D
  1. ..S $P(MONTOT,U,4)=$P(MONTOT,U,4)+DGBTDE
  1. ..S $P(MONTOT,U,4)=$P(MONTOT,U,4)-ODED
  1. CONT ;
  1. D CONT^DGBTCE1 Q
  1. EXIT ;
  1. K DGBTDV1,DGBTRMK Q
  1. ;
  1. DENIED(DGBTDT) ;check for a denied claim
  1. ;
  1. N DENIED
  1. S DENIED=$$GET1^DIQ(392,DGBTDT,45.2,"I")
  1. ;
  1. Q DENIED
  1. ADDTO(MONTOT) ;this will add the current trip to the total trips for the month.
  1. ;
  1. N TRIPTYP
  1. I CHZFLG=1 Q MONTOT
  1. I $D(^DGBT(392,DGBTDT,"M")),$P(^("M"),"^")=1 S TRIPTYP=1
  1. E S TRIPTYP=2
  1. I TRIPTYP=1 S $P(MONTOT,"^",1)=$P(MONTOT,"^",1)+1
  1. I TRIPTYP=2 S $P(MONTOT,"^",1)=$S($P(MONTOT,"^",1)<6:$P(MONTOT,"^",1)+1,1:$P(MONTOT,"^",1)+2)
  1. ;S $P(MONTOT,"^",1)=$S(TRIPTYP=1:$P(MONTOT,"^",1)+1,1:$P(MONTOT,"^",1)+2) ;add current trip to total for month
  1. I TRIPTYP=1 S $P(MONTOT,U,2)=$P(MONTOT,U,2)+1
  1. I TRIPTYP=2 S $P(MONTOT,U,3)=$P(MONTOT,U,3)+1
  1. S $P(MONTOT,"^",6)=$S(TRIPTYP=1:$P(MONTOT,"^",6)+1,1:$P(MONTOT,"^",6)+2)
  1. I ($P(MONTOT,U,5)'["Y")&($P(MONTOT,U)>6) S $P(MONTOT,U,5)="YES"
  1. I ($P(MONTOT,U,5)'["Y")&($P(MONTOT,U,2)>18) S $P(MONTOT,U,5)="YES"
  1. Q MONTOT
  1. ;