source: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTE1.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1DGBTE1 ;ALB/SCK/GAH - BENEFICIARY TRAVEL FIND OLD CLAIM DATES ; 10/10/06 11:17am
2 ;;1.0;Beneficiary Travel;**8,12,13**;September 25, 2001;Build 11
3DATE ; get date for claim, either new or past date
4 K ^TMP("DGBT",$J),^TMP("DGBTARA",$J),DIR
5 I 'DGBTNEW S DIR("A",2)="Enter a 'P' to display Past CLAIM dates for editing."
6 S DIR("A",3)="Time is required when adding a new CLAIM.",DIR("A",4)="",DIR("A",1)="",DIR("A")="Select TRAVEL CLAIM DATE/TIME",DIR("?")="^D HELP^DGBTE1A"
7 S DIR(0)="F",DIR("B")="NOW" D ^DIR K DIR G ERR1:$D(DIRUT)
8 S CHZFLG=0,%DT="EXR",DTSUB=$S(Y="N":"NOW",Y="P":"OLD",Y="p":"OLD",1:"OTHR")_"^DGBTE1A" D @DTSUB K DTSUB
9 G ERR1:$D(DTOUT),DATE:Y1<0 S DGBTA=Y1 G SET:CHZFLG
10DATE1 ; for past claims, set DGBTDT to inverse date of claim date
11 I $D(^DGBT(392,"C",DFN)) D
12 . S DGBTC=0,DGBTDT=9999999-$E(DGBTA,1,7) ; set past claims counter=0
13 . ; for latest date (topmost) search for past claims
14 . F I=DGBTDT:0 S I=$O(^DGBT(392,"AI",DFN,I)) Q:'I!(I>(DGBTDT_.99999)) S DGBTC=DGBTC+1,DGBT(DGBTC)=9999999.99999-I
15 I '$D(DGBT) G LOCK
16 W !!,"There are other claims on this date.",!,"Select by number to edit or <RETURN> to add a new CLAIM.",!
17 ; convert inverse claim date to external format through VADATE conversion routine
18 F I=0:0 S I=$O(DGBT(I)) Q:'I S VADAT("W")=DGBT(I) D ^VADATE W !?5,I,".",?10,VADATE("E")
19 K DIR S DIR("A")="Select 1"_$S(DGBTC=1:"",1:"-"_DGBTC)_", or <RETURN> to add a new claim: ",DIR(0)="NOA^1:"_DGBTC,DIR("?")="Select, by number, one of the displayed claim dates: "
20 D ^DIR K DIR G QUIT^DGBTEND:$D(DTOUT)!($D(DUOUT))
21 G LOCK:Y="" G DATE:'$D(DGBT(Y))
22 S DGBTA=DGBT(Y) G SET
23LOCK ;
24 L ^DGBT(392,DGBTA):1
25 I '$T!$D(^DGBT(392,DGBTA)) L S DGBTA=DGBTA+.00001 G LOCK
26 S VADAT("W")=DGBTA D ^VADATE W VADATE("E")
27ASKADD ;
28 W !!,"Are you sure you want to add a new claim"
29 S %=1 D YN^DICN G PATIENT^DGBTE:%<0!(%=2)
30 I '% W !!,"Enter 'YES' to add a new claim, or 'NO' not to add the claim." G ASKADD
31 K DD,DO
32 ; create new file entry, stuff patient DFN into name field(pointer)
33 S (X,DINUM)=DGBTA,DIC="^DGBT(392,",DIC(0)="L",DIC("DR")="2////"_DFN
34 D FILE^DICN K DIC L
35 ; go back to patient if no file entry
36 G:Y'>0 PATIENT^DGBTE
37SET ; call inhouse generic date routine
38 S (DA,DGBTDT,VADAT("W"))=DGBTA D ^VADATE
39 ; get internal and external formats of converted inverse dates
40 S DGBTDTI=VADATE("I"),DGBTDTE=VADATE("E") K VADAT,VADATE,DIC,Y
41 S DGBTDIVN=$P(^DG(40.8,DGBTDIVI,0),"^",7)
42STUFF ; stuff departure with address data from patient file, dest from institution file
43 S:'$D(^DGBT(392,DGBTDT,"D")) ^DGBT(392,DGBTDT,"D")=VAPA(1)_"^"_VAPA(2)_"^"_VAPA(3)_"^"_VAPA(4)_"^"_$S(VAPA(5)]"":+VAPA(5),1:"")_"^"_$P(VAPA(11),U,1)
44 I '$D(^DGBT(392,DGBTDT,"T")) D
45 . S X=$S($D(^DIC(4,DGBTDIVN,1)):^(1),1:"")
46 . S ^DGBT(392,DGBTDT,"T")=($P(^DG(40.8,DGBTDIVI,0),U)_"^"_$P(X,U)_"^"_$P(X,U,2)_"^"_$P(X,U,3)_"^"_$P(^DIC(4,DGBTDIVN,0),U,2)_"^"_$P(X,U,4))
47CHKFILES ; section removed, dependents picked up below in MEANS ; abr 10/94
48MEANS ; find corres. means test entry, gets MT income, status, no. of dependents
49 ;DGBTMTS= MT Status; DGBTCSC= claim Service Connected indicator & %; DGBTELG=Eligibility status
50 N X,X2,X3,Y,DGBTIFL
51 S X=$$LST^DGMTU(DFN,DGBTA),DGBTMTS=$P(X,U,4)_U_$P(X,U,3) ; returns corres. MT info,X=IEN of last MT
52 ; get income, # dependents
53 S Y=$$INCOME^VAFMON(DFN,DGBTA,1)
54 S X=$P(Y,U),DGBTIFL=$P(Y,U,2) ; returns income & source.
55 I X?1N.E!(X<0) D
56 .I X<0 S X=0
57 .S X2="0$",X3=8 D COMMA^%DTC
58 S DGBTINC=X_U_$G(DGBTIFL) K X,X2
59 S DGBTDEP=$$DEP^VAFMON(DFN,DGBTA) ; finds depedents Vet, Spouse, Children
60 ;
61PREV ; if past claim get SC%, elig.
62 I CHZFLG S X=^DGBT(392,DGBTA,0),DGBTELG=$P(X,U,3),DGBTCSC=$P(X,U,4) D
63 . S:DGBTCSC DGBTCSC=1_U_DGBTCSC S:'DGBTCSC DGBTCSC=0
64 . S:DGBTELG DGBTELG=DGBTELG_U_$P(^DIC(8,DGBTELG,0),U)
65CERT ; get last BT certification, get date, then get eligibility
66 I $D(^DGBT(392.2,"C",DFN)) D
67 .;cd=cert date in inverse then external format, ce= eligibility, ca* = amt certified
68 . S DGBTCD=$O(^DGBT(392.2,"C",DFN,0)),DGBTCE=$P(^DGBT(392.2,DGBTCD,0),"^",3)
69 . S DGBTCA=$P(^DGBT(392.2,DGBTCD,0),"^",4),Y=9999999-$P(DGBTCD,".")
70 . X ^DD("DD") ; date conversion, y=cert date (internal)
71 . S DGBTCD=Y,X=DGBTCA,X2="0$",X3=8 K Y D COMMA^%DTC S DGBTCA=X K X,X2,X3
72APPTS ; search patient file for appointments through claim date (DTI+1), adddates to array DGBTCL
73 N ERRCODE,DGARRAY,CLIEN,APTDT S DGARRAY("FLDS")="2;3;10;18"
74 S DGARRAY(4)=DFN,I=$$SDAPI^SDAMA301(.DGARRAY)
75 ; I<0 = Error, I<0 = # of Records retrieved
76 I I<0 S ERRCODE=$O(^TMP($J,"SDAMA301","")),I1=1,DGBTCL("ERROR")=^TMP($J,"SDAMA301",ERRCODE)
77 I I>0 D
78 .S CLIEN=""
79 .F S CLIEN=$O(^TMP($J,"SDAMA301",DFN,CLIEN)) Q:'CLIEN D
80 ..S APTDT=DGBTDTI\1
81 ..F S APTDT=$O(^TMP($J,"SDAMA301",DFN,CLIEN,APTDT)) Q:'APTDT!(APTDT>(DGBTDTI+1)) D
82 ...S SDATA=^TMP($J,"SDAMA301",DFN,CLIEN,APTDT)
83 ...S DGBTCL(APTDT)=$P($P(^TMP($J,"SDAMA301",DFN,CLIEN,APTDT),U,2),";",2)_U_$P($P(SDATA,U,3),";")
84 ...S DGBTCL(APTDT)=DGBTCL(APTDT)_U_$P($P(SDATA,U,18),";")_U_$P($P(SDATA,U,10),";")
85 K ^TMP($J,"SDAMA301"),DGARRAY,CLIEN,APTDT
86EXIT ; exit routine
87 Q
88ERR1 ; error condition
89 G QUIT^DGBTEND Q
Note: See TracBrowser for help on using the repository browser.