DGBTE1 ;ALB/SCK - BENEFICIARY TRAVEL FIND OLD CLAIM DATES ;11/23/92@0800 03/19/93
;;5.3;Registration;**35,60,90,1015**;Aug 13, 1993;Build 21
DATE ; get date for claim, either new or past date
K ^TMP("DGBT",$J),^TMP("DGBTARA",$J),DIR
I 'DGBTNEW S DIR("A",2)="Enter a 'P' to display Past CLAIM dates for editing."
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"
S DIR(0)="F",DIR("B")="NOW" D ^DIR K DIR G ERR1:$D(DIRUT)
S CHZFLG=0,%DT="EXR",DTSUB=$S(Y="N":"NOW",Y="P":"OLD",Y="p":"OLD",1:"OTHR") D @DTSUB^DGBTE1A K DTSUB
G ERR1:$D(DTOUT),DATE:Y1<0 S DGBTA=Y1 G SET:CHZFLG
DATE1 ; for past claims, set DGBTDT to inverse date of claim date
I $D(^DGBT(392,"C",DFN)) D
. S DGBTC=0,DGBTDT=9999999-$E(DGBTA,1,7) ; set past claims counter=0
. ; for latest date (topmost) search for past claims
. 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
I '$D(DGBT) G LOCK
W !!,"There are other claims on this date.",!,"Select by number to edit or <RETURN> to add a new CLAIM.",!
; convert inverse claim date to external format through VADATE conversion routine
F I=0:0 S I=$O(DGBT(I)) Q:'I S VADAT("W")=DGBT(I) D ^VADATE W !?5,I,".",?10,VADATE("E")
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: "
D ^DIR K DIR G QUIT^DGBTEND:$D(DTOUT)!($D(DUOUT))
G LOCK:Y="" G DATE:'$D(DGBT(Y))
S DGBTA=DGBT(Y) G SET
LOCK ;
L ^DGBT(392,DGBTA):1
I '$T!$D(^DGBT(392,DGBTA)) L S DGBTA=DGBTA+.00001 G LOCK
S VADAT("W")=DGBTA D ^VADATE W VADATE("E")
ASKADD ;
W !!,"Are you sure you want to add a new claim"
S %=1 D YN^DICN G PATIENT^DGBTE:%<0!(%=2)
I '% W !!,"Enter 'YES' to add a new claim, or 'NO' not to add the claim." G ASKADD
K DD,DO
; create new file entry, stuff patient DFN into name field(pointer)
S (X,DINUM)=DGBTA,DIC="^DGBT(392,",DIC(0)="L",DIC("DR")="2////"_DFN
D FILE^DICN K DIC L
; go back to patient if no file entry
G:Y'>0 PATIENT^DGBTE
SET ; call inhouse generic date routine
S (DA,DGBTDT,VADAT("W"))=DGBTA D ^VADATE
; get internal and external formats of converted inverse dates
S DGBTDTI=VADATE("I"),DGBTDTE=VADATE("E") K VADAT,VADATE,DIC,Y
S DGBTDIVN=$P(^DG(40.8,DGBTDIVI,0),"^",7)
STUFF ; stuff departure with address data from patient file, dest from institution file
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)
I '$D(^DGBT(392,DGBTDT,"T")) D
. S X=$S($D(^DIC(4,DGBTDIVN,1)):^(1),1:"")
. 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))
CHKFILES ; section removed, dependents picked up below in MEANS ; abr 10/94
MEANS ; find corres. means test entry, gets MT income, status, no. of dependents
;DGBTMTS= MT Status; DGBTCSC= claim Service Connected indicator & %; DGBTELG=Eligibility status
N X,X2,X3,Y,DGBTIFL
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
; get income, # dependents
S Y=$$INCOME^VAFMON(DFN,DGBTA,1)
S X=$P(Y,U),DGBTIFL=$P(Y,U,2) ; returns income & source.
I X?1N.E!(X<0) D
.I X<0 S X=0
.S X2="0$",X3=8 D COMMA^%DTC
S DGBTINC=X_U_$G(DGBTIFL) K X,X2
S DGBTDEP=$$DEP^VAFMON(DFN,DGBTA) ; finds depedents Vet, Spouse, Children
;
PREV ; if past claim get SC%, elig.
I CHZFLG S X=^DGBT(392,DGBTA,0),DGBTELG=$P(X,U,3),DGBTCSC=$P(X,U,4) D
. S:DGBTCSC DGBTCSC=1_U_DGBTCSC S:'DGBTCSC DGBTCSC=0
. S:DGBTELG DGBTELG=DGBTELG_U_$P(^DIC(8,DGBTELG,0),U)
CERT ; get last BT certification, get date, then get eligibility
I $D(^DGBT(392.2,"C",DFN)) D
.;cd=cert date in inverse then external format, ce= eligibility, ca* = amt certified
. S DGBTCD=$O(^DGBT(392.2,"C",DFN,0)),DGBTCE=$P(^DGBT(392.2,DGBTCD,0),"^",3)
. S DGBTCA=$P(^DGBT(392.2,DGBTCD,0),"^",4),Y=9999999-$P(DGBTCD,".")
. X ^DD("DD") ; date conversion, y=cert date (internal)
. S DGBTCD=Y,X=DGBTCA,X2="0$",X3=8 K Y D COMMA^%DTC S DGBTCA=X K X,X2,X3
APPTS ; search patient file for appointments through claim date (DTI+1), adddates to array DGBTCL
F I=0:0 S I=$O(^DPT(DFN,"S",I)) Q:'I!(I>(DGBTDTI+1)) I $P(I,".")=$P(DGBTDTI,".") S DGBTCL(I)=^(I,0)
EXIT ; exit routine
Q
ERR1 ; error condition
G QUIT^DGBTEND Q
DGBTE1 ;ALB/SCK - BENEFICIARY TRAVEL FIND OLD CLAIM DATES ;11/23/92@0800 03/19/93
+1 ;;5.3;Registration;**35,60,90,1015**;Aug 13, 1993;Build 21
DATE ; get date for claim, either new or past date
+1 KILL ^TMP("DGBT",$JOB),^TMP("DGBTARA",$JOB),DIR
+2 IF 'DGBTNEW
SET DIR("A",2)="Enter a 'P' to display Past CLAIM dates for editing."
+3 SET DIR("A",3)="Time is required when adding a new CLAIM."
SET DIR("A",4)=""
SET DIR("A",1)=""
SET DIR("A")="Select TRAVEL CLAIM DATE/TIME"
SET DIR("?")="^D HELP^DGBTE1A"
+4 SET DIR(0)="F"
SET DIR("B")="NOW"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO ERR1
+5 SET CHZFLG=0
SET %DT="EXR"
SET DTSUB=$SELECT(Y="N":"NOW",Y="P":"OLD",Y="p":"OLD",1:"OTHR")
DO @DTSUB^DGBTE1A
KILL DTSUB
+6 IF $DATA(DTOUT)
GOTO ERR1
IF Y1<0
GOTO DATE
SET DGBTA=Y1
IF CHZFLG
GOTO SET
DATE1 ; for past claims, set DGBTDT to inverse date of claim date
+1 IF $DATA(^DGBT(392,"C",DFN))
Begin DoDot:1
+2 ; set past claims counter=0
SET DGBTC=0
SET DGBTDT=9999999-$EXTRACT(DGBTA,1,7)
+3 ; for latest date (topmost) search for past claims
+4 FOR I=DGBTDT:0
SET I=$ORDER(^DGBT(392,"AI",DFN,I))
IF 'I!(I>(DGBTDT_.99999))
QUIT
SET DGBTC=DGBTC+1
SET DGBT(DGBTC)=9999999.99999-I
End DoDot:1
+5 IF '$DATA(DGBT)
GOTO LOCK
+6 WRITE !!,"There are other claims on this date.",!,"Select by number to edit or <RETURN> to add a new CLAIM.",!
+7 ; convert inverse claim date to external format through VADATE conversion routine
+8 FOR I=0:0
SET I=$ORDER(DGBT(I))
IF 'I
QUIT
SET VADAT("W")=DGBT(I)
DO ^VADATE
WRITE !?5,I,".",?10,VADATE("E")
+9 KILL DIR
SET DIR("A")="Select 1"_$SELECT(DGBTC=1:"",1:"-"_DGBTC)_", or <RETURN> to add a new claim: "
SET DIR(0)="NOA^1:"_DGBTC
SET DIR("?")="Select, by number, one of the displayed claim dates: "
+10 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO QUIT^DGBTEND
+11 IF Y=""
GOTO LOCK
IF '$DATA(DGBT(Y))
GOTO DATE
+12 SET DGBTA=DGBT(Y)
GOTO SET
LOCK ;
+1 LOCK ^DGBT(392,DGBTA):1
+2 IF '$TEST!$DATA(^DGBT(392,DGBTA))
LOCK
SET DGBTA=DGBTA+.00001
GOTO LOCK
+3 SET VADAT("W")=DGBTA
DO ^VADATE
WRITE VADATE("E")
ASKADD ;
+1 WRITE !!,"Are you sure you want to add a new claim"
+2 SET %=1
DO YN^DICN
IF %<0!(%=2)
GOTO PATIENT^DGBTE
+3 IF '%
WRITE !!,"Enter 'YES' to add a new claim, or 'NO' not to add the claim."
GOTO ASKADD
+4 KILL DD,DO
+5 ; create new file entry, stuff patient DFN into name field(pointer)
+6 SET (X,DINUM)=DGBTA
SET DIC="^DGBT(392,"
SET DIC(0)="L"
SET DIC("DR")="2////"_DFN
+7 DO FILE^DICN
KILL DIC
LOCK
+8 ; go back to patient if no file entry
+9 IF Y'>0
GOTO PATIENT^DGBTE
SET ; call inhouse generic date routine
+1 SET (DA,DGBTDT,VADAT("W"))=DGBTA
DO ^VADATE
+2 ; get internal and external formats of converted inverse dates
+3 SET DGBTDTI=VADATE("I")
SET DGBTDTE=VADATE("E")
KILL VADAT,VADATE,DIC,Y
+4 SET DGBTDIVN=$PIECE(^DG(40.8,DGBTDIVI,0),"^",7)
STUFF ; stuff departure with address data from patient file, dest from institution file
+1 IF '$DATA(^DGBT(392,DGBTDT,"D"))
SET ^DGBT(392,DGBTDT,"D")=VAPA(1)_"^"_VAPA(2)_"^"_VAPA(3)_"^"_VAPA(4)_"^"_$SELECT(VAPA(5)]"":+VAPA(5),1:"")_"^"_$PIECE(VAPA(11),U,1)
+2 IF '$DATA(^DGBT(392,DGBTDT,"T"))
Begin DoDot:1
+3 SET X=$SELECT($DATA(^DIC(4,DGBTDIVN,1)):^(1),1:"")
+4 SET ^DGBT(392,DGBTDT,"T")=($PIECE(^DG(40.8,DGBTDIVI,0),U)_"^"_$PIECE(X,U)_"^"_$PIECE(X,U,2)_"^"_$PIECE(X,U,3)_"^"_$PIECE(^DIC(4,DGBTDIVN,0),U,2)_"^"_$PIECE(X,U,4))
End DoDot:1
CHKFILES ; section removed, dependents picked up below in MEANS ; abr 10/94
MEANS ; find corres. means test entry, gets MT income, status, no. of dependents
+1 ;DGBTMTS= MT Status; DGBTCSC= claim Service Connected indicator & %; DGBTELG=Eligibility status
+2 NEW X,X2,X3,Y,DGBTIFL
+3 ; returns corres. MT info,X=IEN of last MT
SET X=$$LST^DGMTU(DFN,DGBTA)
SET DGBTMTS=$PIECE(X,U,4)_U_$PIECE(X,U,3)
+4 ; get income, # dependents
+5 SET Y=$$INCOME^VAFMON(DFN,DGBTA,1)
+6 ; returns income & source.
SET X=$PIECE(Y,U)
SET DGBTIFL=$PIECE(Y,U,2)
+7 IF X?1N.E!(X<0)
Begin DoDot:1
+8 IF X<0
SET X=0
+9 SET X2="0$"
SET X3=8
DO COMMA^%DTC
End DoDot:1
+10 SET DGBTINC=X_U_$GET(DGBTIFL)
KILL X,X2
+11 ; finds depedents Vet, Spouse, Children
SET DGBTDEP=$$DEP^VAFMON(DFN,DGBTA)
+12 ;
PREV ; if past claim get SC%, elig.
+1 IF CHZFLG
SET X=^DGBT(392,DGBTA,0)
SET DGBTELG=$PIECE(X,U,3)
SET DGBTCSC=$PIECE(X,U,4)
Begin DoDot:1
+2 IF DGBTCSC
SET DGBTCSC=1_U_DGBTCSC
IF 'DGBTCSC
SET DGBTCSC=0
+3 IF DGBTELG
SET DGBTELG=DGBTELG_U_$PIECE(^DIC(8,DGBTELG,0),U)
End DoDot:1
CERT ; get last BT certification, get date, then get eligibility
+1 IF $DATA(^DGBT(392.2,"C",DFN))
Begin DoDot:1
+2 ;cd=cert date in inverse then external format, ce= eligibility, ca* = amt certified
+3 SET DGBTCD=$ORDER(^DGBT(392.2,"C",DFN,0))
SET DGBTCE=$PIECE(^DGBT(392.2,DGBTCD,0),"^",3)
+4 SET DGBTCA=$PIECE(^DGBT(392.2,DGBTCD,0),"^",4)
SET Y=9999999-$PIECE(DGBTCD,".")
+5 ; date conversion, y=cert date (internal)
XECUTE ^DD("DD")
+6 SET DGBTCD=Y
SET X=DGBTCA
SET X2="0$"
SET X3=8
KILL Y
DO COMMA^%DTC
SET DGBTCA=X
KILL X,X2,X3
End DoDot:1
APPTS ; search patient file for appointments through claim date (DTI+1), adddates to array DGBTCL
+1 FOR I=0:0
SET I=$ORDER(^DPT(DFN,"S",I))
IF 'I!(I>(DGBTDTI+1))
QUIT
IF $PIECE(I,".")=$PIECE(DGBTDTI,".")
SET DGBTCL(I)=^(I,0)
EXIT ; exit routine
+1 QUIT
ERR1 ; error condition
+1 GOTO QUIT^DGBTEND
QUIT
