Changeset 623 for WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- Location:
- WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCE.m
r613 r623 1 DGBTCE 2 ;;1.0;Beneficiary Travel;**2,14**;September 25, 2001;Build 7 3 4 SCREEN 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 DIE1 24 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)=DGBTMLT25 26 27 28 29 30 31 32 DIE3 33 34 35 TCOST 36 MLFB 37 38 39 40 41 DED 42 43 44 45 46 47 DED1 48 49 DIE4 50 51 CONT 52 53 54 FILE 55 56 57 58 1 DGBTCE ;ALB/SCK - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT; 12/15/92 06/04/93 2 ;;1.0;Beneficiary Travel;**2**;September 25, 2001 3 Q 4 SCREEN ; 5 D QUIT^DGBTCE1 6 D SCREEN^DGBTEE1 Q:'$D(^DGBT(392,DGBTDT,0)) I DGBTTOUT=-1 S DGBTTOUT=1 Q 7 I $D(DGBTOACT) I DGBTOACT'=DGBTACCT S DGBTVAR(0)=^DGBT(392,DGBTDT,0) D FILE 8 S (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDE,DGBTDCV,DGBTDCM,DGBTDPV,DGBTDPM)=0 9 S:$G(DGBTACCT)'>0 DGBTACCT=$P($G(DGBTVAR(0)),U,6) 10 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") 11 D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q 12 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) 13 S DGBTDIV=$P($G(^DGBT(392,DA,0)),U,11),DGBTRMK=$S($D(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDIV,4),1:"") 14 S DIE="^DGBT(392,",DA=DGBTDT 15 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" 16 D ^DIE K DIE I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q 17 W:DGBTRMK]"" !!,*7,"MILEAGE REMARKS: ",DGBTRMK,! 18 I DGBTACCT=4!(DGBTACCT=5) D Q:$G(DGBTTOUT) 19 . S DR="31//;S DGBTOWRT=X;32//;S DGBTML=X" 20 . I DGBTACCT=5&(DGBTCP=1) S DGBTMR=DGBTMR1 21 . S DIE="^DGBT(392,",DA=DGBTDT 22 . D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 23 DIE1 ; 24 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 25 ; 26 S DIE="^DGBT(392,",DA=DGBTDT 27 I 'DGBTCORE D 28 . 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" 29 I DGBTCORE S DR="" D 30 . 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;" 31 . 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" 32 DIE3 ; 33 D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q 34 ; 35 TCOST ;CALCULATE TOTAL COST AND MONTHLY CUM. DEDUCTIBLE 36 MLFB ; 37 S DGBTMAF=$S(DGBTMLFB:DGBTMAL+DGBTFAB,1:0),DGBTMETC=DGBTME+$S($D(DGBTMAL):DGBTMAL,1:0) 38 I DGBTACCT'=4&(DGBTACCT'=5) S DGBTPA=DGBTMAF+DGBTME G CONT 39 I $D(DGBTMLT) S DGBTTC=$S(DGBTMLT+DGBTMAF'>DGBTMETC:DGBTMLT+DGBTMAF,DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0):DGBTMETC,DGBTME'>0:DGBTMLT+DGBTMAF,1:DGBTMETC) 40 I DGBTACCT=5 S DGBTDE=0 S DGBTPA=$S((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC) G CONT 41 DED ; 42 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)) 43 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) 44 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) 45 S DGBTDRM=DGBTDPM-DGBTDCM 46 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) 47 DED1 ; 48 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" 49 DIE4 ; 50 S DIE="^DGBT(392,",DA=DGBTDT D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q 51 CONT ; 52 D CONT^DGBTCE1 53 Q 54 FILE ; Reset values if account changes 55 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:"") 56 I DGBTACCT<4 S DGBTVAR("M")="^^^"_$S($L(DGBTVAR("M"),"^")>3:$P(DGBTVAR("M"),"^",4,$L(DGBTVAR("M"),"^")),1:"") 57 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 58 Q -
WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCR.m
r613 r623 1 DGBTCR ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d VARIABLES; 2/7/88@08:00 ;6/11/93@09:30 2 ;;1.0;Beneficiary Travel;**7,14**;September 25, 2001;Build 7 3 ;Modification of AIVBTPRT / pmg / GRAND ISLAND ; 07 Jul 88 12:02 PM 4 START Q:'$D(DGBTDT) 5 S DGBTVAR(0)=$G(^DGBT(392,+DGBTDT,0)),DGBTACCT=$P($G(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)),"^",5) 6 Q:DGBTACCT'>3 7 W !!,*7,"This needs to be printed at 132 columns" 8 S DGPGM="PRINT^DGBTCR",DGVAR="DGBTDT" 9 S %ZIS="PMQ" D ^%ZIS G QUIT:POP 10 I $D(IO("Q")) D QUE G QUIT 11 D PRINT 12 QUIT ; 13 D:'$D(ZTQUEUED) ^%ZISC 14 K DGPGM,DGVAR,VADAT,VADATE,I,X,X2,DGBTVAR,DGBTCC,DGBTDIV,DGBTDOB,DGBTINS,DGBTINS1,DGBTINS2,DGBTCNA,DGBTCSZ,DGBTCNU,DGBTTCTY,DGBTFCTY,DGBTDT,DGBTACCT,DFN,Y 15 K DGBTM6,DGBTM7,DGBTM8,DGBTM9,DGBTM10,DGBTM11,DGBTM12,DGBTM13,DGBTM14,DGBTM15,DGBTM16,DGBTM17,DGBTRATE,DGBTSCP,DGBTSSN,DGBTST 16 Q 17 PRINT ; 18 U IO D SET,PRINT^DGBTCR1,PRINT^DGBTCR2,KVAR^VADPT 19 Q 20 SET S DFN=$P(^DGBT(392,DGBTDT,0),"^",2) D 6^VADPT S (DGBTFCTY,DGBTTCTY)="" 21 NODES F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") 22 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)) 23 I $P(DGBTVAR("D"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("D"),"^",4) D CITY I DGBTCSZ[DGBTCNA D 24 . S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("D"),"^",5),0),U,2),1:"")_" " 25 . 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 26 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 27 DIV S DGBTDIV=$P(DGBTVAR(0),"^",11) I +DGBTDIV S DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7) S (DGBTCC,DGBTST)="" 28 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) 29 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) 30 ;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) 31 D PID^VADPT6 S DGBTSSN=VA("PID"),DGBTDOB=$E(VADM(3),4,7)_($E(VADM(3),1,3)+1700) 32 S DGBTSCP=$S($L($P(VAEL(3),"^",2)<3):"0",1:"")_$P(VAEL(3),"^",2) 33 MILES S DGBTM6=$P(DGBTVAR("M"),"^")*$P(DGBTVAR("M"),"^",2) 34 N X3 35 S X2="2$",X=DGBTM6*DGBTM7 D COMMA^%DTC S DGBTM8=X 36 S X=$P(DGBTVAR("M"),"^",4) D COMMA^%DTC S DGBTM9=X 37 S X=$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM10=X 38 S X=DGBTM6*DGBTM7+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM11=X 39 S X2="3$",X=DGBTM7 D COMMA^%DTC S DGBTM7=X 40 S X2="2$" ;Reset edit mask to 2 decimal positions for rest of report 41 S X=$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM12=X 42 S X=$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM13=X 43 S X=$P(DGBTVAR(0),"^",10) D COMMA^%DTC S DGBTM14=X 44 S X=$P(DGBTVAR(0),"^",9) D COMMA^%DTC S $P(DGBTM14,"^",2)=X 45 CERT S VADAT("W")=DGBTDT D ^VADATE S DGBTM15=VADATE("E") 46 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 47 S DGBTM17=$P($P(DGBTVAR("A"),"^",2),",",2)_" "_$P($P(DGBTVAR("A"),"^",2),",") 48 Q 49 CITY S DGBTCSZ=DGBTCNA 50 S:VAPA(5)'="" DGBTCNU=$O(^DGBT(392.1,"ACS",DGBTCNA,+VAPA(5),0)) 51 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)) 52 Q 53 QUE ; 54 N I 55 S ZTRTN="PRINT^DGBTCR",ZTDESC="VA FORM 70-3542d" 56 F I="DFN","DGBTDT","DGBTFCTY","DGBTTCTY" S ZTSAVE(I)="" 57 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK 58 D HOME^%ZIS K IO("Q") 59 Q 1 DGBTCR ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d VARIABLES; 2/7/88@08:00 ;6/11/93@09:30 2 ;;1.0;Beneficiary Travel;**7**;September 25, 2001 3 ;Modification of AIVBTPRT / pmg / GRAND ISLAND ; 07 Jul 88 12:02 PM 4 START Q:'$D(DGBTDT) 5 S DGBTVAR(0)=$G(^DGBT(392,+DGBTDT,0)),DGBTACCT=$P($G(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)),"^",5) 6 Q:DGBTACCT'>3 7 W !!,*7,"This needs to be printed at 132 columns" 8 S DGPGM="PRINT^DGBTCR",DGVAR="DGBTDT" 9 S %ZIS="PMQ" D ^%ZIS G QUIT:POP 10 I $D(IO("Q")) D QUE G QUIT 11 D PRINT 12 QUIT ; 13 D:'$D(ZTQUEUED) ^%ZISC 14 K DGPGM,DGVAR,VADAT,VADATE,I,X,X2,DGBTVAR,DGBTCC,DGBTDIV,DGBTDOB,DGBTINS,DGBTINS1,DGBTINS2,DGBTCNA,DGBTCSZ,DGBTCNU,DGBTTCTY,DGBTFCTY,DGBTDT,DGBTACCT,DFN,Y 15 K DGBTM6,DGBTM7,DGBTM8,DGBTM9,DGBTM10,DGBTM11,DGBTM12,DGBTM13,DGBTM14,DGBTM15,DGBTM16,DGBTM17,DGBTRATE,DGBTSCP,DGBTSSN,DGBTST 16 Q 17 PRINT ; 18 U IO D SET,PRINT^DGBTCR1,PRINT^DGBTCR2,KVAR^VADPT 19 Q 20 SET S DFN=$P(^DGBT(392,DGBTDT,0),"^",2) D 6^VADPT S (DGBTFCTY,DGBTTCTY)="" 21 NODES F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") 22 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)) 23 I $P(DGBTVAR("D"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("D"),"^",4) D CITY I DGBTCSZ[DGBTCNA D 24 . S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("D"),"^",5),0),U,2),1:"")_" " 25 . 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 26 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 27 DIV S DGBTDIV=$P(DGBTVAR(0),"^",11) I +DGBTDIV S DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7) S (DGBTCC,DGBTST)="" 28 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) 29 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) 30 ;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) 31 D PID^VADPT6 S DGBTSSN=VA("PID"),DGBTDOB=$E(VADM(3),4,7)_($E(VADM(3),1,3)+1700) 32 S DGBTSCP=$S($L($P(VAEL(3),"^",2)<3):"0",1:"")_$P(VAEL(3),"^",2) 33 MILES S DGBTM6=$P(DGBTVAR("M"),"^")*$P(DGBTVAR("M"),"^",2) 34 N X3 35 S X2="2$",X=DGBTM6*DGBTM7 D COMMA^%DTC S DGBTM8=X 36 S X=$P(DGBTVAR("M"),"^",4) D COMMA^%DTC S DGBTM9=X 37 S X=$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM10=X 38 S X=DGBTM6*DGBTM7+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM11=X 39 S X=DGBTM7 D COMMA^%DTC S DGBTM7=X 40 S X=$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM12=X 41 S X=$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM13=X 42 S X=$P(DGBTVAR(0),"^",10) D COMMA^%DTC S DGBTM14=X 43 S X=$P(DGBTVAR(0),"^",9) D COMMA^%DTC S $P(DGBTM14,"^",2)=X 44 CERT S VADAT("W")=DGBTDT D ^VADATE S DGBTM15=VADATE("E") 45 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 46 S DGBTM17=$P($P(DGBTVAR("A"),"^",2),",",2)_" "_$P($P(DGBTVAR("A"),"^",2),",") 47 Q 48 CITY S DGBTCSZ=DGBTCNA 49 S:VAPA(5)'="" DGBTCNU=$O(^DGBT(392.1,"ACS",DGBTCNA,+VAPA(5),0)) 50 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)) 51 Q 52 QUE ; 53 N I 54 S ZTRTN="PRINT^DGBTCR",ZTDESC="VA FORM 70-3542d" 55 F I="DFN","DGBTDT","DGBTFCTY","DGBTTCTY" S ZTSAVE(I)="" 56 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK 57 D HOME^%ZIS K IO("Q") 58 Q -
WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE.m
r613 r623 1 DGBTEE 2 ;;1.0;Beneficiary Travel;**2,14**;September 25, 2001;Build 7 3 4 SCREEN 5 6 7 8 MILES 9 10 11 12 13 14 15 DIE1 16 17 18 19 20 21 22 23 24 25 26 EDIT 27 28 S:DGBTACCT=5&(DGBTCP=1) DGBTMR=DGBTMR1 S DGBTMLT=DGBTOWRT*DGBTML*DGBTMR,DGBTMLT=$J(DGBTMLT,0,2),DR="33///"_DGBTMLT29 30 DIE2 31 32 33 34 35 36 37 DIE3 38 39 40 41 42 TCOST 43 MLFB 44 45 46 47 48 49 50 DIE4 51 52 CONT 53 54 EXIT 55 1 DGBTEE ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT; 12/3/92@1600 2 ;;1.0;Beneficiary Travel;**2**;September 25, 2001 3 Q 4 SCREEN ; 5 D SCREEN^DGBTEE1 Q:DGBTTOUT=-1!(DGBTTOUT=1) Q:'$D(^DGBT(392,DGBTDT,0)) 6 ; The following section of code moved to DGBTEE2 for space problems 7 D STUFF^DGBTEE2 8 MILES ; get miles between dep. and dest. using function call to DGBTUTL 9 K X,DGBTREC S (DGBTOWRT,DGBTML,DGBTMLT)="" 10 I DGBTFR4]""&((DGBTACCT=4)!(DGBTACCT=5)) I $D(^DGBT(392.1,"ACS",DGBTFR4,+VAPA(5))) D 11 . 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) 12 . ; function $$miles passes city's record# and div name to function, mileage value is returned 13 . I X'="" S DGBTREC=X,DGBTML=$$MILES^DGBTUTL(DGBTREC,DGBTDV1),DGBTOWRT="ROUND TRIP" K X 14 S (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDCV,DGBTDE,DGBTDCM,DGBTDPV,DGBTDPM)=0 15 DIE1 ; stuff from,to address, meals, ferry's/bridges 16 Q:'$D(^DGBT(392,DGBTDT,0)) 17 S DIE="^DGBT(392,",DA=DGBTDT,DR=$S(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44") 18 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q 19 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" 20 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q 21 ; function $$diclkup passes the city's record #, div name, and a flag for remarks (4), remarks or a null are returned 22 I DGBTACCT=4!(DGBTACCT=5) D 23 . W !!,"Please wait, Checking Mileage ..." 24 . S DGBTRMK=$S($D(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,4),1:"") I $D(DGBTDEF),DGBTDEF S DGBTRMK="DEFAULT MILEAGE USED" 25 . I DGBTRMK]"" W !,*7,"MILEAGE REMARKS: ",DGBTRMK,! 26 EDIT ; display trip type, mileage 27 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 28 S:DGBTACCT=5&(DGBTCP=1) DGBTMR=DGBTMR1 S DGBTMLT=DGBTOWRT*DGBTML*DGBTMR,DR="33///"_DGBTMLT 29 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q 30 DIE2 ; stuff eligibility data, SC%, acct. type 31 S DIE("NO^")="12345" S:'$D(DGBTCD) DGBTCD="" 32 I 'DGBTCORE D 33 . 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" 34 I DGBTCORE D 35 . S DR(1,392,1)="3////"_DGBTELIG_";4////"_DGBTSCP_";5///"_DGBTCD_";6////"_DGBTACTN_";I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;" 36 . 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" 37 DIE3 ; get most econ. cost 38 D ^DIE K DR I X=""!(X="^") S DGBTTOUT=-1 Q 39 ; function $$diclkup passes the city's record #, division name, and flag for MEC (3), the MEC is returned 40 S:$D(DGBTREC) DGBTME=$$DICLKUP^DGBTUTL(DGBTREC,DGBTDV1,3) S:DGBTME="" DGBTME=0 S DR="8//"_DGBTME_";S DGBTME=X" 41 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 G EXIT 42 TCOST ; calculate total cost and monthly cum. deductable 43 MLFB ; 44 S DGBTMAF=$S(DGBTMLFB:DGBTMAL+DGBTFAB,1:0),DGBTMETC=DGBTME+$S($D(DGBTMAL):DGBTMAL,1:0) 45 I DGBTACCT'=4&(DGBTACCT'=5) S DGBTPA=DGBTMAF+DGBTME G CONT 46 I $D(DGBTMLT) S DGBTTC=$S(DGBTMLT+DGBTMAF'>DGBTMETC:DGBTMLT+DGBTMAF,DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0):DGBTMETC,DGBTME'>0:DGBTMLT+DGBTMAF,1:DGBTMETC) 47 I DGBTACCT=5 S DGBTDE=0 S DGBTPA=$S((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC) G CONT 48 ; the following section of code moved to DGBTEE2 for space reasons 49 D DED^DGBTEE2 50 DIE4 ; display deductable amount 51 D ^DIE I X=""!(X="^") S DGBTTOUT=-1 Q 52 CONT ; 53 D CONT^DGBTCE1 Q 54 EXIT ; 55 K DGBTDV1,DGBTRMK Q -
WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE1.m
r613 r623 1 DGBTEE1 2 ;;1.0;Beneficiary Travel;**14**;September 25, 2001;Build 7 3 4 SCREEN 5 6 7 8 9 10 11 12 START 13 14 15 16 17 18 19 20 21 22 23 ELIG1 24 25 26 27 28 29 30 31 32 33 ECHOZ 34 35 36 37 38 39 ESET 40 41 42 ESET1 43 44 CERT 45 46 47 ACCT 48 49 50 51 52 53 54 55 I $D(DGBTVAR("M")) S DGBTML=$P(DGBTVAR("M"),"^",2),DGBTOWRT=$P(DGBTVAR("M"),"^"),DGBTMLT=$J((DGBTML*DGBTOWRT*DGBTMR),0,2) 56 QUIT 57 58 59 60 DEFLT1() 61 62 63 64 1 DGBTEE1 ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT CHECK; 12/7/92 3/19/93 2 ;;1.0;Beneficiary Travel;;September 25, 2001 3 Q 4 SCREEN ; called by dgbtee,dgbtce 5 Q:'$D(^DGBT(392,DGBTDT,0)) 6 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 7 W @IOF S DGBTFLAG=0 8 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 9 W !?16,"Beneficiary Travel Claim Information <Enter/Edit>" 10 D PID^VADPT6 11 W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),"^",2),! 12 START ; ask date/time, and division 13 K DIC,^TMP("DGBT",$J),X 14 S DIE="^DGBT(392,",DIE("NO^")="OUTOK" 15 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" 16 S DIDEL=392 ; allows users to delete BT claims 17 D ^DIE K DIE,DIDEL,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=-1 Q 18 K X 19 I '$D(^DGBT(392,DGBTDT,0)) Q 20 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 21 ; set rates and build eligibilities in DGBTEE2 22 D RATES^DGBTEE2 23 ELIG1 ; select eligibility from those available in TMP list 24 I '$O(VAEL(1,0)) S DGBTELIG=+VAEL(1) G ESET1 25 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:"") 26 S DIR(0)="F",DIR("?")="^D ELIST^DGBTEE2" 27 D ^DIR K DIR I $D(DUOUT) W !?3,"SORRY, '^' NOT ALLOWED!!" G ELIG1 28 I $D(DTOUT) S DGBTTOUT=-1 Q 29 S:Y="" DGBTELIG=$S($P(^DGBT(392,DGBTDT,0),"^",3):$P(^(0),"^",3),1:+VAEL(1)) ; ref file #392, claims 30 I X["@" W !,"ELIGIBILITY REQUIRED." G ELIG1 31 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 32 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 33 ECHOZ ; 34 W !!,"Choose by NUMBER the primary eligibility or other entitled eligibilities",! 35 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) 36 K DIR,X S DIR("A")="Choose 1-"_DGBTCT,DIR(0)="NO^1:"_DGBTCT,DIR("?")="Enter choice from those displayed" 37 D ^DIR K DIR G:$D(DIRUT) ELIG1 S XX=Y 38 I '$D(^TMP("DGBT",$J,Y)) W " ?? ",!,"Select ELIGIBILITY: " G ECHOZ 39 ESET ; 40 S:$D(Y) DGBTELIG=$S($D(^TMP("DGBT",$J,Y)):+^TMP("DGBT",$J,Y),'$D(XX):Y,1:+VAEL(1)) 41 W:Y]"" ?30,$E($P(^DIC(8,+DGBTELIG,0),"^"),$S($D(XX):($L(XX)+1),1:1),99) 42 ESET1 ; 43 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:"") 44 CERT ; stuff of certification date if appropriate 45 ; naked global ref file #392.2, certification file. 46 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),"^") 47 ACCT ; allowed to select only valid active accounts 48 S DGBTOACT=$S('$D(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)):0,1:+$P(^DGBT(392.3,$P(DGBTVAR(0),"^",6),0),"^",5)) 49 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: " 50 S DIC="^DGBT(392.3,",DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,3)'>DGBTDT&('$P(^(0),U,4)!($P(^(0),U,4)'<DGBTDT))" 51 D ^DIC K DIC I $D(DTOUT) S DGBTTOUT=-1 K DTOUT Q 52 I Y'>0 W !,"ACCOUNT IS REQUIRED!!" G ACCT 53 S DGBTACTN=$P(Y,"^"),DGBTACCT=$P(Y(0),"^",5) 54 ; if account is ALL OTHER - stuff in mileage info 55 I $D(DGBTVAR("M")) S DGBTML=$P(DGBTVAR("M"),"^",2),DGBTOWRT=$P(DGBTVAR("M"),"^"),DGBTMLT=DGBTML*DGBTOWRT*DGBTMR 56 QUIT ; 57 K A,C,I,IA,J,X,XX,^TMP("DGBT",$J),DGBTDIV,DGBTIDT,DGBTCT 58 Q 59 ; 60 DEFLT1() ; 61 N REC,Y 62 S REC="0" F S REC=$O(^DGBT(392.3,REC)) Q:'REC D Q:$D(Y) 63 . S:$P(^DGBT(392.3,REC,0),U,5)=4&($P(^(0),U,3)'>DGBTDT&('$P(^(0),U,4)!($P(^(0),U,4)'<DGBTDT))) Y=$P(^(0),U,1) 64 Q $G(Y) -
WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEF1.m
r613 r623 1 DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ;12/14/92 3/12/93 2 ;;1.0;Beneficiary Travel;**2,14**;September 25, 2001;Build 7 3 RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES 4 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 5 Q ;This Q was added under direction of CBO to remove site's ability to edit rates 6 W !!,"New travel rates are determined each fiscal year. The rates should be",!,"entered each year with the effective date of Oct 1.",! 7 W !,"Changing values for the current or past fiscal years could result in changes",!,"to the claims already entered.",! 8 DATE ; change deductible rates for FY 9 Q ;This Q was added under direction of CBO to remove site's ability to edit rates 10 S DIR("A")="Select EFFECTIVE DATE",DIR(0)="DO^^E",DIR("?")="^D HELP1^DGBTEF1" 11 D ^DIR K DIR G QUIT:$D(DIRUT) G HELP:$E(Y,4,7)'="1001" S X=+Y 12 S DIC="^DG(43.1,",DIC(0)="ELQMZ" 13 D ^DIC G QUIT:Y'>0 S DA=+Y 14 S DGBTN=$S('$D(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT")) 15 S:$D(DGBTN)&($P(DGBTN,"^")]"") DIR("B")=$P(DGBTN,"^") 16 S DGBTDEDV=$$DEDUCT(6,"VISIT") G:DGBTDEDV<0 QUIT1 17 S DIE="^DG(43.1,",DR="30.01///^S X=DGBTDEDV" 18 D ^DIE 19 S:$D(DGBTN)&($P(DGBTN,"^",2)]"") DIR("B")=$P(DGBTN,"^",2) 20 S DGBTDEDM=$$DEDUCT(18,"MONTH") G:DGBTDEDM<0 QUIT1 21 S DIE="^DG(43.1,",DR="30.02///^S X=DGBTDEDM" 22 D ^DIE 23 S DR="30.03;30.05;30.04",DIE="^DG(43.1," 24 D ^DIE G QUIT1 25 ACCT ; change activation/inactivation dates for accounts 26 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." 27 W !,"DO NOT add to this file unless so instructed by Fiscal Service.",! 28 TYPE ; select account to edit 29 S DIR("A")="Select ACCOUNT",DIR("?")="^D HELP2^DGBTEF1",DIR(0)="FO" 30 D ^DIR K DIR G QUIT:$D(DIRUT) S X=Y 31 S DIC="^DGBT(392.3,",DIC(0)="ELQMZ" 32 D ^DIC G TYPE:Y'>0 33 S DA=+Y,DR="2:4",DIE="^DGBT(392.3," D ^DIE G TYPE 34 NWACT ;enter/edit account file (392.3);option DGBT BENE TRAVEL ACCOUNT 35 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.",! 36 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 37 ED ; edit data for new account 38 W ! K X,DA 39 S (DIE,DIC)="^DGBT(392.3,",DIC(0)="AEQLMZ",DLAYGO=392.3,DIC("DR")="" 40 D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT)!(X="") QUIT1 G:Y'>0 ED 41 S DR="2///"_$P(Y(0)," ",1)_";3;4;5" ; account number now stuffed, not asked 42 S DA=+Y L ^DGBT(392.3,DA):2 E W !?5,"Another user is editing this entry.",*7 G ED 43 S DIE("NO^")=1 44 D ^DIE L K DR,DIE,DIE("NO^") 45 W ! S DIR(0)="Y",DIR("A")="Would you like to Enter/Edit another ACCOUNT",DIR("B")="Yes" 46 D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(Y=0) QUIT1 G ED 47 QUIT1 ; 48 K DIR,DTOUT,DI,D0,DUOUT,DIRUT,DGBTN,DGBTDEDV,DGBTDEDM 49 QUIT ; 50 K %DT,DA,DIC,DIE,DIE("NO^"),DR,X,Y Q 51 DEDUCT(LIMIT,TYPE) ; enter new deductble value 52 DEDCT1 S DIR(0)="FAO",DIR("A")="ENTER DEDUCTIBLE AMOUNT/"_TYPE_": " 53 S DIR("?")="Type a dollar amount between 0 and "_LIMIT_" with up to 2 decimal places." 54 D ^DIR K DIR I $D(DUOUT)!($D(DTOUT))!(Y']"") S Y=-1 G DEDUCTQ 55 S:Y["$" Y=$P(Y,"$",2) 56 I Y'?.N,Y'?.N1".".N K X,Y,DIR G DEDCT1 57 I Y>(LIMIT+.001) W " -- Deductible exceeds limit." K X,Y,DIR G DEDCT1 58 DEDUCTQ Q (+Y) 59 ; 60 HELP W !!,"The effective date must start on the fiscal year, Oct 1.",! G DATE 61 HELP1 S DIC="^DG(43.1,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q 62 HELP2 S DIC="^DGBT(392.3,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q 1 DGBTEF1 ;ALB/SCK - BENEFICIARY TRAVEL UPDATE PARAMETERS INTO FILES ;12/14/92 3/12/93 2 ;;1.0;Beneficiary Travel;**2**;September 25, 2001 3 RATES ;enter/edit bene travel parameters;option DGBT BENE TRAVEL RATES 4 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 5 W !!,"New travel rates are determined each fiscal year. The rates should be",!,"entered each year with the effective date of Oct 1.",! 6 W !,"Changing values for the current or past fiscal years could result in changes",!,"to the claims already entered.",! 7 DATE ; change deductible rates for FY 8 S DIR("A")="Select EFFECTIVE DATE",DIR(0)="DO^^E",DIR("?")="^D HELP1^DGBTEF1" 9 D ^DIR K DIR G QUIT:$D(DIRUT) G HELP:$E(Y,4,7)'="1001" S X=+Y 10 S DIC="^DG(43.1,",DIC(0)="ELQMZ" 11 D ^DIC G QUIT:Y'>0 S DA=+Y 12 S DGBTN=$S('$D(^DG(43.1,DA,"BT")):"",1:^DG(43.1,DA,"BT")) 13 S:$D(DGBTN)&($P(DGBTN,"^")]"") DIR("B")=$P(DGBTN,"^") 14 S DGBTDEDV=$$DEDUCT(6,"VISIT") G:DGBTDEDV<0 QUIT1 15 S DIE="^DG(43.1,",DR="30.01///^S X=DGBTDEDV" 16 D ^DIE 17 S:$D(DGBTN)&($P(DGBTN,"^",2)]"") DIR("B")=$P(DGBTN,"^",2) 18 S DGBTDEDM=$$DEDUCT(18,"MONTH") G:DGBTDEDM<0 QUIT1 19 S DIE="^DG(43.1,",DR="30.02///^S X=DGBTDEDM" 20 D ^DIE 21 S DR="30.03;30.05;30.04",DIE="^DG(43.1," 22 D ^DIE G QUIT1 23 ACCT ; change activation/inactivation dates for accounts 24 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." 25 W !,"DO NOT add to this file unless so instructed by Fiscal Service.",! 26 TYPE ; select account to edit 27 S DIR("A")="Select ACCOUNT",DIR("?")="^D HELP2^DGBTEF1",DIR(0)="FO" 28 D ^DIR K DIR G QUIT:$D(DIRUT) S X=Y 29 S DIC="^DGBT(392.3,",DIC(0)="ELQMZ" 30 D ^DIC G TYPE:Y'>0 31 S DA=+Y,DR="2:4",DIE="^DGBT(392.3," D ^DIE G TYPE 32 NWACT ;enter/edit account file (392.3);option DGBT BENE TRAVEL ACCOUNT 33 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.",! 34 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 35 ED ; edit data for new account 36 W ! K X,DA 37 S (DIE,DIC)="^DGBT(392.3,",DIC(0)="AEQLMZ",DLAYGO=392.3,DIC("DR")="" 38 D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT)!(X="") QUIT1 G:Y'>0 ED 39 S DR="2///"_$P(Y(0)," ",1)_";3;4;5" ; account number now stuffed, not asked 40 S DA=+Y L ^DGBT(392.3,DA):2 E W !?5,"Another user is editing this entry.",*7 G ED 41 S DIE("NO^")=1 42 D ^DIE L K DR,DIE,DIE("NO^") 43 W ! S DIR(0)="Y",DIR("A")="Would you like to Enter/Edit another ACCOUNT",DIR("B")="Yes" 44 D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(Y=0) QUIT1 G ED 45 QUIT1 ; 46 K DIR,DTOUT,DI,D0,DUOUT,DIRUT,DGBTN,DGBTDEDV,DGBTDEDM 47 QUIT ; 48 K %DT,DA,DIC,DIE,DIE("NO^"),DR,X,Y Q 49 DEDUCT(LIMIT,TYPE) ; enter new deductble value 50 DEDCT1 S DIR(0)="FAO",DIR("A")="ENTER DEDUCTIBLE AMOUNT/"_TYPE_": " 51 S DIR("?")="Type a dollar amount between 0 and "_LIMIT_" with up to 2 decimal places." 52 D ^DIR K DIR I $D(DUOUT)!($D(DTOUT))!(Y']"") S Y=-1 G DEDUCTQ 53 S:Y["$" Y=$P(Y,"$",2) 54 I Y'?.N,Y'?.N1".".N K X,Y,DIR G DEDCT1 55 I Y>(LIMIT+.001) W " -- Deductible exceeds limit." K X,Y,DIR G DEDCT1 56 DEDUCTQ Q (+Y) 57 ; 58 HELP W !!,"The effective date must start on the fiscal year, Oct 1.",! G DATE 59 HELP1 S DIC="^DG(43.1,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q 60 HELP2 S DIC="^DGBT(392.3,",DIC(0)="QMZ",X="?" D ^DIC K DIC Q
Note:
See TracChangeset
for help on using the changeset viewer.
