Index: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCE.m =================================================================== --- WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCE.m (revision 613) +++ WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCE.m (revision 623) @@ -1,58 +1,58 @@ -DGBTCE ;ALB/SCK - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT; 12/15/92 06/04/93 - ;;1.0;Beneficiary Travel;**2,14**;September 25, 2001;Build 7 - 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)):$J((DGBTOWRT*DGBTML*DGBTMR),0,2),1:""),$P(^DGBT(392,DGBTDT,"M"),"^",3)=DGBTMLT,$P(DGBTVAR("M"),"^",3)=DGBTMLT - ; - S DIE="^DGBT(392,",DA=DGBTDT - I 'DGBTCORE D - . S 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" - I DGBTCORE S DR="" D - . S DR(1,392,1)="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392,D0,X,$G(DGBTPRV)) S:DGBTCSL<1 Y=""@3"" W:DGBTCSL<1 "" Required"" K DGBTPRV,DGBTCSL;" - . S DR(1,392,2)="@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'DGBTDPV):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'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.0;Beneficiary Travel;**2**;September 25, 2001 + 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 + I 'DGBTCORE D + . S 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" + I DGBTCORE S DR="" D + . S DR(1,392,1)="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392,D0,X,$G(DGBTPRV)) S:DGBTCSL<1 Y=""@3"" W:DGBTCSL<1 "" Required"" K DGBTPRV,DGBTCSL;" + . S DR(1,392,2)="@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'DGBTDPV):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'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 Index: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCR.m =================================================================== --- WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCR.m (revision 613) +++ WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCR.m (revision 623) @@ -1,59 +1,58 @@ -DGBTCR ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d VARIABLES; 2/7/88@08:00 ;6/11/93@09:30 - ;;1.0;Beneficiary Travel;**7,14**;September 25, 2001;Build 7 - ;Modification of AIVBTPRT / pmg / GRAND ISLAND ; 07 Jul 88 12:02 PM -START Q:'$D(DGBTDT) - S DGBTVAR(0)=$G(^DGBT(392,+DGBTDT,0)),DGBTACCT=$P($G(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)),"^",5) - Q:DGBTACCT'>3 - W !!,*7,"This needs to be printed at 132 columns" - S DGPGM="PRINT^DGBTCR",DGVAR="DGBTDT" - S %ZIS="PMQ" D ^%ZIS G QUIT:POP - I $D(IO("Q")) D QUE G QUIT - D PRINT -QUIT ; - D:'$D(ZTQUEUED) ^%ZISC - K DGPGM,DGVAR,VADAT,VADATE,I,X,X2,DGBTVAR,DGBTCC,DGBTDIV,DGBTDOB,DGBTINS,DGBTINS1,DGBTINS2,DGBTCNA,DGBTCSZ,DGBTCNU,DGBTTCTY,DGBTFCTY,DGBTDT,DGBTACCT,DFN,Y - K DGBTM6,DGBTM7,DGBTM8,DGBTM9,DGBTM10,DGBTM11,DGBTM12,DGBTM13,DGBTM14,DGBTM15,DGBTM16,DGBTM17,DGBTRATE,DGBTSCP,DGBTSSN,DGBTST - Q -PRINT ; - U IO D SET,PRINT^DGBTCR1,PRINT^DGBTCR2,KVAR^VADPT - Q -SET S DFN=$P(^DGBT(392,DGBTDT,0),"^",2) D 6^VADPT S (DGBTFCTY,DGBTTCTY)="" -NODES F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") - I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) S DGBTRATE=^("BT"),DGBTM7=$S($P(DGBTVAR("A"),"^",3)=1:$P(DGBTRATE,"^",5),1:$P(DGBTRATE,"^",3)) - I $P(DGBTVAR("D"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("D"),"^",4) D CITY I DGBTCSZ[DGBTCNA D - . S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("D"),"^",5),0),U,2),1:"")_" " - . S Y=$P(DGBTVAR("D"),U,6),Y=$E(Y,1,5)_$S($E(Y,6,9)]"":"-"_$E(Y,6,9),1:""),DGBTCSZ=DGBTCSZ_Y,DGBTFCTY=DGBTCSZ - I $P(DGBTVAR("T"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("T"),U,4) D CITY^DGBTCR S:DGBTCSZ[DGBTCNA DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("T"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("T"),"^",5),0),U,2),1:"")_" "_$P(DGBTVAR("T"),U,6) S DGBTTCTY=DGBTCSZ -DIV S DGBTDIV=$P(DGBTVAR(0),"^",11) I +DGBTDIV S DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7) S (DGBTCC,DGBTST)="" - I $D(^DIC(4,+DGBTDIV,0)) S DGBTINS=^(0),DGBTINS1=$S($D(^DIC(4,DGBTDIV,1)):^(1),1:""),DGBTINS2=$S(DGBTINS1]"":$P(DGBTINS1,"^",3)_",",1:"UNSPECIFIED")_" "_$S($D(^DIC(5,+$P(DGBTINS,U,2),0)):$P(^(0),U,2),1:"")_" "_$P(DGBTINS1,"^",4) - I VAPA(5)&(VAPA(7)) S DGBTCC=$S($D(^DIC(5,+VAPA(5),1,+VAPA(7),0)):$P(^(0),"^",3),1:""),DGBTST=$P(^DIC(5,+VAPA(5),0),"^",2) - ;S DGBTSSN=$P($P(VADM(2),"^",2),"-")_" "_$P($P(VADM(2),"^",2),"-",2)_" "_$P($P(VADM(2),"^",2),"-",3),DGBTDOB=$E(VADM(3),4,7)_$E(VADM(3),2,3) - D PID^VADPT6 S DGBTSSN=VA("PID"),DGBTDOB=$E(VADM(3),4,7)_($E(VADM(3),1,3)+1700) - S DGBTSCP=$S($L($P(VAEL(3),"^",2)<3):"0",1:"")_$P(VAEL(3),"^",2) -MILES S DGBTM6=$P(DGBTVAR("M"),"^")*$P(DGBTVAR("M"),"^",2) - N X3 - S X2="2$",X=DGBTM6*DGBTM7 D COMMA^%DTC S DGBTM8=X - S X=$P(DGBTVAR("M"),"^",4) D COMMA^%DTC S DGBTM9=X - S X=$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM10=X - S X=DGBTM6*DGBTM7+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM11=X - S X2="3$",X=DGBTM7 D COMMA^%DTC S DGBTM7=X - S X2="2$" ;Reset edit mask to 2 decimal positions for rest of report - S X=$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM12=X - S X=$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM13=X - S X=$P(DGBTVAR(0),"^",10) D COMMA^%DTC S DGBTM14=X - S X=$P(DGBTVAR(0),"^",9) D COMMA^%DTC S $P(DGBTM14,"^",2)=X -CERT S VADAT("W")=DGBTDT D ^VADATE S DGBTM15=VADATE("E") - S X=$S($P(^DG(43,1,"BT"),"^")'="":$P(^DG(43,1,"BT"),"^"),1:DUZ),DGBTM16=$P($P(^VA(200,X,0),",",2),"^")_" "_$P(^VA(200,X,0),",")_$S($P(^DG(43,1,"BT"),"^")'="":"",1:", DESIGNEE OF CERTIFYING OFFICIAL") K X - S DGBTM17=$P($P(DGBTVAR("A"),"^",2),",",2)_" "_$P($P(DGBTVAR("A"),"^",2),",") - Q -CITY S DGBTCSZ=DGBTCNA - S:VAPA(5)'="" DGBTCNU=$O(^DGBT(392.1,"ACS",DGBTCNA,+VAPA(5),0)) - I $D(DGBTCNU),(DGBTCNU'="") S DGBTCSZ=$P(^DGBT(392.1,DGBTCNU,0),"^")_", "_($P(^DIC(5,+VAPA(5),0),"^",2))_" "_($P(^DGBT(392.1,DGBTCNU,0),"^",4)) - Q -QUE ; - N I - S ZTRTN="PRINT^DGBTCR",ZTDESC="VA FORM 70-3542d" - F I="DFN","DGBTDT","DGBTFCTY","DGBTTCTY" S ZTSAVE(I)="" - D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK - D HOME^%ZIS K IO("Q") - Q +DGBTCR ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d VARIABLES; 2/7/88@08:00 ;6/11/93@09:30 + ;;1.0;Beneficiary Travel;**7**;September 25, 2001 + ;Modification of AIVBTPRT / pmg / GRAND ISLAND ; 07 Jul 88 12:02 PM +START Q:'$D(DGBTDT) + S DGBTVAR(0)=$G(^DGBT(392,+DGBTDT,0)),DGBTACCT=$P($G(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)),"^",5) + Q:DGBTACCT'>3 + W !!,*7,"This needs to be printed at 132 columns" + S DGPGM="PRINT^DGBTCR",DGVAR="DGBTDT" + S %ZIS="PMQ" D ^%ZIS G QUIT:POP + I $D(IO("Q")) D QUE G QUIT + D PRINT +QUIT ; + D:'$D(ZTQUEUED) ^%ZISC + K DGPGM,DGVAR,VADAT,VADATE,I,X,X2,DGBTVAR,DGBTCC,DGBTDIV,DGBTDOB,DGBTINS,DGBTINS1,DGBTINS2,DGBTCNA,DGBTCSZ,DGBTCNU,DGBTTCTY,DGBTFCTY,DGBTDT,DGBTACCT,DFN,Y + K DGBTM6,DGBTM7,DGBTM8,DGBTM9,DGBTM10,DGBTM11,DGBTM12,DGBTM13,DGBTM14,DGBTM15,DGBTM16,DGBTM17,DGBTRATE,DGBTSCP,DGBTSSN,DGBTST + Q +PRINT ; + U IO D SET,PRINT^DGBTCR1,PRINT^DGBTCR2,KVAR^VADPT + Q +SET S DFN=$P(^DGBT(392,DGBTDT,0),"^",2) D 6^VADPT S (DGBTFCTY,DGBTTCTY)="" +NODES F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") + I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) S DGBTRATE=^("BT"),DGBTM7=$S($P(DGBTVAR("A"),"^",3)=1:$P(DGBTRATE,"^",5),1:$P(DGBTRATE,"^",3)) + I $P(DGBTVAR("D"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("D"),"^",4) D CITY I DGBTCSZ[DGBTCNA D + . S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("D"),"^",5),0),U,2),1:"")_" " + . S Y=$P(DGBTVAR("D"),U,6),Y=$E(Y,1,5)_$S($E(Y,6,9)]"":"-"_$E(Y,6,9),1:""),DGBTCSZ=DGBTCSZ_Y,DGBTFCTY=DGBTCSZ + I $P(DGBTVAR("T"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("T"),U,4) D CITY^DGBTCR S:DGBTCSZ[DGBTCNA DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("T"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("T"),"^",5),0),U,2),1:"")_" "_$P(DGBTVAR("T"),U,6) S DGBTTCTY=DGBTCSZ +DIV S DGBTDIV=$P(DGBTVAR(0),"^",11) I +DGBTDIV S DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7) S (DGBTCC,DGBTST)="" + I $D(^DIC(4,+DGBTDIV,0)) S DGBTINS=^(0),DGBTINS1=$S($D(^DIC(4,DGBTDIV,1)):^(1),1:""),DGBTINS2=$S(DGBTINS1]"":$P(DGBTINS1,"^",3)_",",1:"UNSPECIFIED")_" "_$S($D(^DIC(5,+$P(DGBTINS,U,2),0)):$P(^(0),U,2),1:"")_" "_$P(DGBTINS1,"^",4) + I VAPA(5)&(VAPA(7)) S DGBTCC=$S($D(^DIC(5,+VAPA(5),1,+VAPA(7),0)):$P(^(0),"^",3),1:""),DGBTST=$P(^DIC(5,+VAPA(5),0),"^",2) + ;S DGBTSSN=$P($P(VADM(2),"^",2),"-")_" "_$P($P(VADM(2),"^",2),"-",2)_" "_$P($P(VADM(2),"^",2),"-",3),DGBTDOB=$E(VADM(3),4,7)_$E(VADM(3),2,3) + D PID^VADPT6 S DGBTSSN=VA("PID"),DGBTDOB=$E(VADM(3),4,7)_($E(VADM(3),1,3)+1700) + S DGBTSCP=$S($L($P(VAEL(3),"^",2)<3):"0",1:"")_$P(VAEL(3),"^",2) +MILES S DGBTM6=$P(DGBTVAR("M"),"^")*$P(DGBTVAR("M"),"^",2) + N X3 + S X2="2$",X=DGBTM6*DGBTM7 D COMMA^%DTC S DGBTM8=X + S X=$P(DGBTVAR("M"),"^",4) D COMMA^%DTC S DGBTM9=X + S X=$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM10=X + S X=DGBTM6*DGBTM7+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM11=X + S X=DGBTM7 D COMMA^%DTC S DGBTM7=X + S X=$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM12=X + S X=$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM13=X + S X=$P(DGBTVAR(0),"^",10) D COMMA^%DTC S DGBTM14=X + S X=$P(DGBTVAR(0),"^",9) D COMMA^%DTC S $P(DGBTM14,"^",2)=X +CERT S VADAT("W")=DGBTDT D ^VADATE S DGBTM15=VADATE("E") + S X=$S($P(^DG(43,1,"BT"),"^")'="":$P(^DG(43,1,"BT"),"^"),1:DUZ),DGBTM16=$P($P(^VA(200,X,0),",",2),"^")_" "_$P(^VA(200,X,0),",")_$S($P(^DG(43,1,"BT"),"^")'="":"",1:", DESIGNEE OF CERTIFYING OFFICIAL") K X + S DGBTM17=$P($P(DGBTVAR("A"),"^",2),",",2)_" "_$P($P(DGBTVAR("A"),"^",2),",") + Q +CITY S DGBTCSZ=DGBTCNA + S:VAPA(5)'="" DGBTCNU=$O(^DGBT(392.1,"ACS",DGBTCNA,+VAPA(5),0)) + I $D(DGBTCNU),(DGBTCNU'="") S DGBTCSZ=$P(^DGBT(392.1,DGBTCNU,0),"^")_", "_($P(^DIC(5,+VAPA(5),0),"^",2))_" "_($P(^DGBT(392.1,DGBTCNU,0),"^",4)) + Q +QUE ; + N I + S ZTRTN="PRINT^DGBTCR",ZTDESC="VA FORM 70-3542d" + F I="DFN","DGBTDT","DGBTFCTY","DGBTTCTY" S ZTSAVE(I)="" + D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK + D HOME^%ZIS K IO("Q") + Q Index: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE.m =================================================================== --- WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE.m (revision 613) +++ WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE.m (revision 623) @@ -1,55 +1,55 @@ -DGBTEE ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT; 12/3/92@1600 - ;;1.0;Beneficiary Travel;**2,14**;September 25, 2001;Build 7 - 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,DGBTMLT=$J(DGBTMLT,0,2),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="" - 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;S DGBTMAL=X;35;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;S DGBTMAL=X;35;S DGBTFAB=X;@2" -DIE3 ; get most econ. cost - D ^DIE K DR 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.0;Beneficiary Travel;**2**;September 25, 2001 + 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="" + 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;S DGBTMAL=X;35;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;S DGBTMAL=X;35;S DGBTFAB=X;@2" +DIE3 ; get most econ. cost + D ^DIE K DR 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 Index: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE1.m =================================================================== --- WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE1.m (revision 613) +++ WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE1.m (revision 623) @@ -1,64 +1,64 @@ -DGBTEE1 ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT CHECK; 12/7/92 3/19/93 - ;;1.0;Beneficiary Travel;**14**;September 25, 2001;Build 7 - Q -SCREEN ; called by dgbtee,dgbtce - Q:'$D(^DGBT(392,DGBTDT,0)) - K DGBTVAR F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") ; ref file #392, claims - W @IOF S DGBTFLAG=0 - I '$D(^DG(43,1,"BT"))!('$D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT"))) W !!,"Module has not been properly initialized - to continue you should first complete",!,"the parameters" Q - W !?16,"Beneficiary Travel Claim Information " - D PID^VADPT6 - W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),"^",2),! -START ; ask date/time, and division - K DIC,^TMP("DGBT",$J),X - S DIE="^DGBT(392,",DIE("NO^")="OUTOK" - S DR=".01;S (DGBTDT,VADAT(""W""))=X D ^VADATE S DGBTDTI=VADATE(""I""),DGBTDTE=VADATE(""E"") K VADAT,VADATE I '$D(DGBTMD) S Y=""@1"";11;@1" - S DIDEL=392 ; allows users to delete BT claims - D ^DIE K DIE,DIDEL,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=-1 Q - K X - I '$D(^DGBT(392,DGBTDT,0)) Q - I $D(^DGBT(392,DGBTDT,0)) L ^DGBT(392,DGBTDT):2 I '$T W !?5,"Another user is editing this entry.",*7 S DGBTTOUT=1 G QUIT - ; set rates and build eligibilities in DGBTEE2 - D RATES^DGBTEE2 -ELIG1 ; select eligibility from those available in TMP list - I '$O(VAEL(1,0)) S DGBTELIG=+VAEL(1) G ESET1 - S DIR("A")="Select ELIGIBILITY",DIR("B")=$S($P(^DGBT(392,DGBTDT,0),"^",3):$P(^DIC(8,$P(^DGBT(392,DGBTDT,0),"^",3),0),"^"),VAEL(1):$P(VAEL(1),"^",2),1:"") - S DIR(0)="F",DIR("?")="^D ELIST^DGBTEE2" - D ^DIR K DIR I $D(DUOUT) W !?3,"SORRY, '^' NOT ALLOWED!!" G ELIG1 - I $D(DTOUT) S DGBTTOUT=-1 Q - S:Y="" DGBTELIG=$S($P(^DGBT(392,DGBTDT,0),"^",3):$P(^(0),"^",3),1:+VAEL(1)) ; ref file #392, claims - I X["@" W !,"ELIGIBILITY REQUIRED." G ELIG1 - I Y?1A.E F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I I $E($P(^(I),"^",2),1,$L(X))=X S XX=Y,Y=I G ESET ; ref ^TMP file for eligibility - I +Y?1N.N S Y=+Y F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I I +$P(^(I),"^")=Y S XX=Y,Y=I G ESET ; ref ^TMP file for eligibility -ECHOZ ; - W !!,"Choose by NUMBER the primary eligibility or other entitled eligibilities",! - I DGBTCT>1 F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I W !?5,I,?10,$P(^TMP("DGBT",$J,I),"^",2) - K DIR,X S DIR("A")="Choose 1-"_DGBTCT,DIR(0)="NO^1:"_DGBTCT,DIR("?")="Enter choice from those displayed" - D ^DIR K DIR G:$D(DIRUT) ELIG1 S XX=Y - I '$D(^TMP("DGBT",$J,Y)) W " ?? ",!,"Select ELIGIBILITY: " G ECHOZ -ESET ; - S:$D(Y) DGBTELIG=$S($D(^TMP("DGBT",$J,Y)):+^TMP("DGBT",$J,Y),'$D(XX):Y,1:+VAEL(1)) - W:Y]"" ?30,$E($P(^DIC(8,+DGBTELIG,0),"^"),$S($D(XX):($L(XX)+1),1:1),99) -ESET1 ; - S DGBTSCP=$S($P(^DIC(8,DGBTELIG,0),"^",9)=1&(+VAEL(3)):$P(VAEL(3),"^",2),$P(^DIC(8,DGBTELIG,0),"^",9)=3&(+VAEL(3)):$P(VAEL(3),"^",2),1:"") -CERT ; stuff of certification date if appropriate - ; naked global ref file #392.2, certification file. - I $P(VAEL(3),"^") S DGBTCD="" I VAEL(3)&($P(VAEL(3),"^",2)'>29) S DGBTIDT=9999999.99999-DGBTDT F I=0:0 S I=$O(^DGBT(392.2,"C",DFN,I)) Q:'I I I'>DGBTIDT&($P(^DGBT(392.2,I,0),"^",3)) S DGBTCD=$P(^(0),"^") -ACCT ; allowed to select only valid active accounts - S DGBTOACT=$S('$D(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)):0,1:+$P(^DGBT(392.3,$P(DGBTVAR(0),"^",6),0),"^",5)) - K X S (DIC("B"),X)=$S(+$P(DGBTVAR(0),"^",6):$P(^DGBT(392.3,$P(DGBTVAR(0),"^",6),0),"^"),1:$$DEFLT1) S DIC("A")="Select ACCOUNT: " - S DIC="^DGBT(392.3,",DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,3)'>DGBTDT&('$P(^(0),U,4)!($P(^(0),U,4)'0 W !,"ACCOUNT IS REQUIRED!!" G ACCT - S DGBTACTN=$P(Y,"^"),DGBTACCT=$P(Y(0),"^",5) - ; if account is ALL OTHER - stuff in mileage info - I $D(DGBTVAR("M")) S DGBTML=$P(DGBTVAR("M"),"^",2),DGBTOWRT=$P(DGBTVAR("M"),"^"),DGBTMLT=$J((DGBTML*DGBTOWRT*DGBTMR),0,2) -QUIT ; - K A,C,I,IA,J,X,XX,^TMP("DGBT",$J),DGBTDIV,DGBTIDT,DGBTCT - Q - ; -DEFLT1() ; - N REC,Y - S REC="0" F S REC=$O(^DGBT(392.3,REC)) Q:'REC D Q:$D(Y) - . S:$P(^DGBT(392.3,REC,0),U,5)=4&($P(^(0),U,3)'>DGBTDT&('$P(^(0),U,4)!($P(^(0),U,4)'" + D PID^VADPT6 + W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),"^",2),! +START ; ask date/time, and division + K DIC,^TMP("DGBT",$J),X + S DIE="^DGBT(392,",DIE("NO^")="OUTOK" + S DR=".01;S (DGBTDT,VADAT(""W""))=X D ^VADATE S DGBTDTI=VADATE(""I""),DGBTDTE=VADATE(""E"") K VADAT,VADATE I '$D(DGBTMD) S Y=""@1"";11;@1" + S DIDEL=392 ; allows users to delete BT claims + D ^DIE K DIE,DIDEL,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=-1 Q + K X + I '$D(^DGBT(392,DGBTDT,0)) Q + I $D(^DGBT(392,DGBTDT,0)) L ^DGBT(392,DGBTDT):2 I '$T W !?5,"Another user is editing this entry.",*7 S DGBTTOUT=1 G QUIT + ; set rates and build eligibilities in DGBTEE2 + D RATES^DGBTEE2 +ELIG1 ; select eligibility from those available in TMP list + I '$O(VAEL(1,0)) S DGBTELIG=+VAEL(1) G ESET1 + S DIR("A")="Select ELIGIBILITY",DIR("B")=$S($P(^DGBT(392,DGBTDT,0),"^",3):$P(^DIC(8,$P(^DGBT(392,DGBTDT,0),"^",3),0),"^"),VAEL(1):$P(VAEL(1),"^",2),1:"") + S DIR(0)="F",DIR("?")="^D ELIST^DGBTEE2" + D ^DIR K DIR I $D(DUOUT) W !?3,"SORRY, '^' NOT ALLOWED!!" G ELIG1 + I $D(DTOUT) S DGBTTOUT=-1 Q + S:Y="" DGBTELIG=$S($P(^DGBT(392,DGBTDT,0),"^",3):$P(^(0),"^",3),1:+VAEL(1)) ; ref file #392, claims + I X["@" W !,"ELIGIBILITY REQUIRED." G ELIG1 + I Y?1A.E F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I I $E($P(^(I),"^",2),1,$L(X))=X S XX=Y,Y=I G ESET ; ref ^TMP file for eligibility + I +Y?1N.N S Y=+Y F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I I +$P(^(I),"^")=Y S XX=Y,Y=I G ESET ; ref ^TMP file for eligibility +ECHOZ ; + W !!,"Choose by NUMBER the primary eligibility or other entitled eligibilities",! + I DGBTCT>1 F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I W !?5,I,?10,$P(^TMP("DGBT",$J,I),"^",2) + K DIR,X S DIR("A")="Choose 1-"_DGBTCT,DIR(0)="NO^1:"_DGBTCT,DIR("?")="Enter choice from those displayed" + D ^DIR K DIR G:$D(DIRUT) ELIG1 S XX=Y + I '$D(^TMP("DGBT",$J,Y)) W " ?? ",!,"Select ELIGIBILITY: " G ECHOZ +ESET ; + S:$D(Y) DGBTELIG=$S($D(^TMP("DGBT",$J,Y)):+^TMP("DGBT",$J,Y),'$D(XX):Y,1:+VAEL(1)) + W:Y]"" ?30,$E($P(^DIC(8,+DGBTELIG,0),"^"),$S($D(XX):($L(XX)+1),1:1),99) +ESET1 ; + S DGBTSCP=$S($P(^DIC(8,DGBTELIG,0),"^",9)=1&(+VAEL(3)):$P(VAEL(3),"^",2),$P(^DIC(8,DGBTELIG,0),"^",9)=3&(+VAEL(3)):$P(VAEL(3),"^",2),1:"") +CERT ; stuff of certification date if appropriate + ; naked global ref file #392.2, certification file. + I $P(VAEL(3),"^") S DGBTCD="" I VAEL(3)&($P(VAEL(3),"^",2)'>29) S DGBTIDT=9999999.99999-DGBTDT F I=0:0 S I=$O(^DGBT(392.2,"C",DFN,I)) Q:'I I I'>DGBTIDT&($P(^DGBT(392.2,I,0),"^",3)) S DGBTCD=$P(^(0),"^") +ACCT ; allowed to select only valid active accounts + S DGBTOACT=$S('$D(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)):0,1:+$P(^DGBT(392.3,$P(DGBTVAR(0),"^",6),0),"^",5)) + K X S (DIC("B"),X)=$S(+$P(DGBTVAR(0),"^",6):$P(^DGBT(392.3,$P(DGBTVAR(0),"^",6),0),"^"),1:$$DEFLT1) S DIC("A")="Select ACCOUNT: " + S DIC="^DGBT(392.3,",DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,3)'>DGBTDT&('$P(^(0),U,4)!($P(^(0),U,4)'0 W !,"ACCOUNT IS REQUIRED!!" G ACCT + S DGBTACTN=$P(Y,"^"),DGBTACCT=$P(Y(0),"^",5) + ; if account is ALL OTHER - stuff in mileage info + I $D(DGBTVAR("M")) S DGBTML=$P(DGBTVAR("M"),"^",2),DGBTOWRT=$P(DGBTVAR("M"),"^"),DGBTMLT=DGBTML*DGBTOWRT*DGBTMR +QUIT ; + K A,C,I,IA,J,X,XX,^TMP("DGBT",$J),DGBTDIV,DGBTIDT,DGBTCT + Q + ; +DEFLT1() ; + N REC,Y + S REC="0" F S REC=$O(^DGBT(392.3,REC)) Q:'REC D Q:$D(Y) + . S:$P(^DGBT(392.3,REC,0),U,5)=4&($P(^(0),U,3)'>DGBTDT&('$P(^(0),U,4)!($P(^(0),U,4)'0 S DA=+Y - S DGBTN=$S('$D(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT")) - S:$D(DGBTN)&($P(DGBTN,"^")]"") DIR("B")=$P(DGBTN,"^") - S DGBTDEDV=$$DEDUCT(6,"VISIT") G:DGBTDEDV<0 QUIT1 - S DIE="^DG(43.1,",DR="30.01///^S X=DGBTDEDV" - D ^DIE - S:$D(DGBTN)&($P(DGBTN,"^",2)]"") DIR("B")=$P(DGBTN,"^",2) - S DGBTDEDM=$$DEDUCT(18,"MONTH") G:DGBTDEDM<0 QUIT1 - S DIE="^DG(43.1,",DR="30.02///^S X=DGBTDEDM" - D ^DIE - S DR="30.03;30.05;30.04",DIE="^DG(43.1," - D ^DIE G QUIT1 -ACCT ; change activation/inactivation dates for accounts - W !!,"ACCOUNT TYPES are determined by Fiscal Service and have a direct impact",!,"on the type of questions asked in the Beneficiary Travel CLAIM ENTER/EDIT",!,"option." - W !,"DO NOT add to this file unless so instructed by Fiscal Service.",! -TYPE ; select account to edit - S DIR("A")="Select ACCOUNT",DIR("?")="^D HELP2^DGBTEF1",DIR(0)="FO" - D ^DIR K DIR G QUIT:$D(DIRUT) S X=Y - S DIC="^DGBT(392.3,",DIC(0)="ELQMZ" - D ^DIC G TYPE:Y'>0 - S DA=+Y,DR="2:4",DIE="^DGBT(392.3," D ^DIE G TYPE -NWACT ;enter/edit account file (392.3);option DGBT BENE TRAVEL ACCOUNT - W !!?3,"You are about to enter/edit Bene Travel account types. Although",!?3,"this process is now decentralized, changes and additions should be",!?3,"made with extreme care.",! - S DIR(0)="Y",DIR("A")="Are you sure you wish to continue",DIR("B")="No" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!('Y) G QUIT1 -ED ; edit data for new account - W ! K X,DA - S (DIE,DIC)="^DGBT(392.3,",DIC(0)="AEQLMZ",DLAYGO=392.3,DIC("DR")="" - D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT)!(X="") QUIT1 G:Y'>0 ED - S DR="2///"_$P(Y(0)," ",1)_";3;4;5" ; account number now stuffed, not asked - S DA=+Y L ^DGBT(392.3,DA):2 E W !?5,"Another user is editing this entry.",*7 G ED - S DIE("NO^")=1 - D ^DIE L K DR,DIE,DIE("NO^") - W ! S DIR(0)="Y",DIR("A")="Would you like to Enter/Edit another ACCOUNT",DIR("B")="Yes" - D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(Y=0) QUIT1 G ED -QUIT1 ; - K DIR,DTOUT,DI,D0,DUOUT,DIRUT,DGBTN,DGBTDEDV,DGBTDEDM -QUIT ; - K %DT,DA,DIC,DIE,DIE("NO^"),DR,X,Y Q -DEDUCT(LIMIT,TYPE) ; enter new deductble value -DEDCT1 S DIR(0)="FAO",DIR("A")="ENTER DEDUCTIBLE AMOUNT/"_TYPE_": " - S DIR("?")="Type a dollar amount between 0 and "_LIMIT_" with up to 2 decimal places." - D ^DIR K DIR I $D(DUOUT)!($D(DTOUT))!(Y']"") S Y=-1 G DEDUCTQ - S:Y["$" Y=$P(Y,"$",2) - I Y'?.N,Y'?.N1".".N K X,Y,DIR G DEDCT1 - I Y>(LIMIT+.001) W " -- Deductible exceeds limit." K X,Y,DIR G DEDCT1 -DEDUCTQ Q (+Y) - ; -HELP W !!,"The effective date must start on the fiscal year, Oct 1.",! G DATE -HELP1 S DIC="^DG(43.1,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q -HELP2 S DIC="^DGBT(392.3,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q +DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ;12/14/92 3/12/93 + ;;1.0;Beneficiary Travel;**2**;September 25, 2001 +RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES + S DA=1,DR="720;723;721",DIE="^DG(43," D ^DIE G QUIT:X="^"!($D(DTOUT))!($D(Y)) K DA,DE,DQ,DR,DIE + W !!,"New travel rates are determined each fiscal year. The rates should be",!,"entered each year with the effective date of Oct 1.",! + W !,"Changing values for the current or past fiscal years could result in changes",!,"to the claims already entered.",! +DATE ; change deductible rates for FY + S DIR("A")="Select EFFECTIVE DATE",DIR(0)="DO^^E",DIR("?")="^D HELP1^DGBTEF1" + D ^DIR K DIR G QUIT:$D(DIRUT) G HELP:$E(Y,4,7)'="1001" S X=+Y + S DIC="^DG(43.1,",DIC(0)="ELQMZ" + D ^DIC G QUIT:Y'>0 S DA=+Y + S DGBTN=$S('$D(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT")) + S:$D(DGBTN)&($P(DGBTN,"^")]"") DIR("B")=$P(DGBTN,"^") + S DGBTDEDV=$$DEDUCT(6,"VISIT") G:DGBTDEDV<0 QUIT1 + S DIE="^DG(43.1,",DR="30.01///^S X=DGBTDEDV" + D ^DIE + S:$D(DGBTN)&($P(DGBTN,"^",2)]"") DIR("B")=$P(DGBTN,"^",2) + S DGBTDEDM=$$DEDUCT(18,"MONTH") G:DGBTDEDM<0 QUIT1 + S DIE="^DG(43.1,",DR="30.02///^S X=DGBTDEDM" + D ^DIE + S DR="30.03;30.05;30.04",DIE="^DG(43.1," + D ^DIE G QUIT1 +ACCT ; change activation/inactivation dates for accounts + W !!,"ACCOUNT TYPES are determined by Fiscal Service and have a direct impact",!,"on the type of questions asked in the Beneficiary Travel CLAIM ENTER/EDIT",!,"option." + W !,"DO NOT add to this file unless so instructed by Fiscal Service.",! +TYPE ; select account to edit + S DIR("A")="Select ACCOUNT",DIR("?")="^D HELP2^DGBTEF1",DIR(0)="FO" + D ^DIR K DIR G QUIT:$D(DIRUT) S X=Y + S DIC="^DGBT(392.3,",DIC(0)="ELQMZ" + D ^DIC G TYPE:Y'>0 + S DA=+Y,DR="2:4",DIE="^DGBT(392.3," D ^DIE G TYPE +NWACT ;enter/edit account file (392.3);option DGBT BENE TRAVEL ACCOUNT + W !!?3,"You are about to enter/edit Bene Travel account types. Although",!?3,"this process is now decentralized, changes and additions should be",!?3,"made with extreme care.",! + S DIR(0)="Y",DIR("A")="Are you sure you wish to continue",DIR("B")="No" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!('Y) G QUIT1 +ED ; edit data for new account + W ! K X,DA + S (DIE,DIC)="^DGBT(392.3,",DIC(0)="AEQLMZ",DLAYGO=392.3,DIC("DR")="" + D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT)!(X="") QUIT1 G:Y'>0 ED + S DR="2///"_$P(Y(0)," ",1)_";3;4;5" ; account number now stuffed, not asked + S DA=+Y L ^DGBT(392.3,DA):2 E W !?5,"Another user is editing this entry.",*7 G ED + S DIE("NO^")=1 + D ^DIE L K DR,DIE,DIE("NO^") + W ! S DIR(0)="Y",DIR("A")="Would you like to Enter/Edit another ACCOUNT",DIR("B")="Yes" + D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(Y=0) QUIT1 G ED +QUIT1 ; + K DIR,DTOUT,DI,D0,DUOUT,DIRUT,DGBTN,DGBTDEDV,DGBTDEDM +QUIT ; + K %DT,DA,DIC,DIE,DIE("NO^"),DR,X,Y Q +DEDUCT(LIMIT,TYPE) ; enter new deductble value +DEDCT1 S DIR(0)="FAO",DIR("A")="ENTER DEDUCTIBLE AMOUNT/"_TYPE_": " + S DIR("?")="Type a dollar amount between 0 and "_LIMIT_" with up to 2 decimal places." + D ^DIR K DIR I $D(DUOUT)!($D(DTOUT))!(Y']"") S Y=-1 G DEDUCTQ + S:Y["$" Y=$P(Y,"$",2) + I Y'?.N,Y'?.N1".".N K X,Y,DIR G DEDCT1 + I Y>(LIMIT+.001) W " -- Deductible exceeds limit." K X,Y,DIR G DEDCT1 +DEDUCTQ Q (+Y) + ; +HELP W !!,"The effective date must start on the fiscal year, Oct 1.",! G DATE +HELP1 S DIC="^DG(43.1,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q +HELP2 S DIC="^DGBT(392.3,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q