DGBT1 ;ALB/SCK - BENEFICIARY TRAVEL DISPLAY SCREEN 1; 12/15/92 1/8/93 4/1/93
;;5.3;Registration;**35,60,119,1015**;Aug 13, 1993;Build 21
Q
SCREEN ; clear screen and write headers
W @IOF
W !?18,"Beneficiary Travel Claim Information <Screen 1>"
W !!?2,"Claim Date: ",DGBTDTE
D PID^VADPT6 W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),"^",2)
W !!?5,"Address: ",VAPA(1) W:VAPA(2)]"" !?14,VAPA(2) W:VAPA(3)]"" !?14,VAPA(3) W !?14,VAPA(4),$S(VAPA(4)]"":", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),U,2),1:"UNSPECIFIED")
SETVAR ; if new claim, move in current info for elig, sc%
I 'CHZFLG S DGBTELG=VAEL(1),DGBTCSC=VAEL(3)
I +DGBTELG=3,'$E(DGBTCSC)=1 S DGBTCSC=1
W !!," Eligibility: ",$P(DGBTELG,"^",2) W:DGBTCSC ?45,"SC%: ",$P(DGBTCSC,"^",2)
I $O(VAEL(1,0))'="" W !," Other Elig.: " F I=0:0 S I=$O(VAEL(1,I)) Q:'I W ?14,$P(VAEL(1,I),"^",2),!
SC ; service connected status/information
I DGBTCSC&($P(DGBTCSC,"^",2)'>29) W !!,"Disabilities:" S I3="" F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=^(I,0),I2=$S($D(^DIC(31,+I1,0)):$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",1:"NSC")_")",1:""),I3=I1 W ?14,I2,!
INCOME ; income and eligibility information
N DGBTIFL S DGBTIFL=$P(DGBTINC,U,2)
W !!?2,"Income: ",$P(DGBTINC,U),?40,"Source of Income: ",$S(DGBTIFL="M":"MEANS TEST",DGBTIFL="C":"COPAY TEST",DGBTIFL="I":"INCOME SCREENING",DGBTIFL="V":"VA CHECK",1:"")
W !?2,"No. of Dependents: ",DGBTDEP
I DGBTMTS]"" W:$P(DGBTMTS,"^")'="N" ?40,"MT Status: ",$S($P(DGBTMTS,"^")="R":"REQUIRED",$P(DGBTMTS,"^")="P":$P($P(DGBTMTS,"^",2)," "),DGBTMTS=U:" NOT APPLICABLE",1:$P(DGBTMTS,"^",2))
W:$P(DGBTMTS,"^")="P" !?68,$P($P(DGBTMTS,"^",2)," ",2)
I $P(DGBTMTS,"^")="N" W !!?20,"MEANS TEST ",$P(DGBTMTS,"^",2)
;
W !!?2,"BT Income: ",$S($D(DGBTCA):DGBTCA,1:"NOT RECORDED") W:$D(DGBTCE) ?25,"Certified Eligible: ",$S(DGBTCE:"YES",1:"NO"),?53,"Date Certified: ",$S($D(DGBTCD):DGBTCD,1:"NOT RECORDED")
I $D(DGBTCE) I DGBTCE'=1 W *7,*7,!!?8,"* * * NOTE * * PATIENT HAS BEEN CERTIFIED INELIGIBLE BASED ON INCOME"
S DGBTINFL="" I $D(DGBTINC),$D(DGBTCA),$P(DGBTINC,U)'=DGBTCA,$P(DGBTMTS,"^")'="N" S DGBTINFL=" * * * * Discrepancy exists in incomes reported, please verify * * * *" W !!?5,DGBTINFL
F I=$Y:1:20 W !
QUIT ;
K I1,I2,I3
Q
DGBT1 ;ALB/SCK - BENEFICIARY TRAVEL DISPLAY SCREEN 1; 12/15/92 1/8/93 4/1/93
+1 ;;5.3;Registration;**35,60,119,1015**;Aug 13, 1993;Build 21
+2 QUIT
SCREEN ; clear screen and write headers
+1 WRITE @IOF
+2 WRITE !?18,"Beneficiary Travel Claim Information <Screen 1>"
+3 WRITE !!?2,"Claim Date: ",DGBTDTE
+4 DO PID^VADPT6
WRITE !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$PIECE(VADM(3),"^",2)
+5 WRITE !!?5,"Address: ",VAPA(1)
IF VAPA(2)]""
WRITE !?14,VAPA(2)
IF VAPA(3)]""
WRITE !?14,VAPA(3)
WRITE !?14,VAPA(4),$SELECT(VAPA(4)]"":", "_$PIECE(VAPA(5),"^",2)_" "_$PIECE(VAPA(11),U,2),1:"UNSPECIFIED")
SETVAR ; if new claim, move in current info for elig, sc%
+1 IF 'CHZFLG
SET DGBTELG=VAEL(1)
SET DGBTCSC=VAEL(3)
+2 IF +DGBTELG=3
IF '$EXTRACT(DGBTCSC)=1
SET DGBTCSC=1
+3 WRITE !!," Eligibility: ",$PIECE(DGBTELG,"^",2)
IF DGBTCSC
WRITE ?45,"SC%: ",$PIECE(DGBTCSC,"^",2)
+4 IF $ORDER(VAEL(1,0))'=""
WRITE !," Other Elig.: "
FOR I=0:0
SET I=$ORDER(VAEL(1,I))
IF 'I
QUIT
WRITE ?14,$PIECE(VAEL(1,I),"^",2),!
SC ; service connected status/information
+1 IF DGBTCSC&($PIECE(DGBTCSC,"^",2)'>29)
WRITE !!,"Disabilities:"
SET I3=""
FOR I=0:0
SET I=$ORDER(^DPT(DFN,.372,I))
IF 'I
QUIT
SET I1=^(I,0)
SET I2=$SELECT($DATA(^DIC(31,+I1,0)):$PIECE(^(0),"^",1)_" ("_+$PIECE(I1,"^",2)_"%-"_$SELECT($PIECE(I1,"^",3):"SC",1:"NSC")_")",1:"")
SET I3=I1
WRITE ?14,I2,!
INCOME ; income and eligibility information
+1 NEW DGBTIFL
SET DGBTIFL=$PIECE(DGBTINC,U,2)
+2 WRITE !!?2,"Income: ",$PIECE(DGBTINC,U),?40,"Source of Income: ",$SELECT(DGBTIFL="M":"MEANS TEST",DGBTIFL="C":"COPAY TEST",DGBTIFL="I":"INCOME SCREENING",DGBTIFL="V":"VA CHECK",1:"")
+3 WRITE !?2,"No. of Dependents: ",DGBTDEP
+4 IF DGBTMTS]""
IF $PIECE(DGBTMTS,"^")'="N"
WRITE ?40,"MT Status: ",$SELECT($PIECE(DGBTMTS,"^")="R":"REQUIRED",$PIECE(DGBTMTS,"^")="P":$PIECE($PIECE(DGBTMTS,"^",2)," "),DGBTMTS=U:" NOT APPLICABLE",1:$PIECE(DGBTMTS,"^",2))
+5 IF $PIECE(DGBTMTS,"^")="P"
WRITE !?68,$PIECE($PIECE(DGBTMTS,"^",2)," ",2)
+6 IF $PIECE(DGBTMTS,"^")="N"
WRITE !!?20,"MEANS TEST ",$PIECE(DGBTMTS,"^",2)
+7 ;
+8 WRITE !!?2,"BT Income: ",$SELECT($DATA(DGBTCA):DGBTCA,1:"NOT RECORDED")
IF $DATA(DGBTCE)
WRITE ?25,"Certified Eligible: ",$SELECT(DGBTCE:"YES",1:"NO"),?53,"Date Certified: ",$SELECT($DATA(DGBTCD):DGBTCD,1:"NOT RECORDED")
+9 IF $DATA(DGBTCE)
IF DGBTCE'=1
WRITE *7,*7,!!?8,"* * * NOTE * * PATIENT HAS BEEN CERTIFIED INELIGIBLE BASED ON INCOME"
+10 SET DGBTINFL=""
IF $DATA(DGBTINC)
IF $DATA(DGBTCA)
IF $PIECE(DGBTINC,U)'=DGBTCA
IF $PIECE(DGBTMTS,"^")'="N"
SET DGBTINFL=" * * * * Discrepancy exists in incomes reported, please verify * * * *"
WRITE !!?5,DGBTINFL
+11 FOR I=$Y:1:20
WRITE !
QUIT ;
+1 KILL I1,I2,I3
+2 QUIT