Changeset 623 for WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTEE1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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)
Note:
See TracChangeset
for help on using the changeset viewer.
