- 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
