Routine: DGBT1

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

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

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

DGBT1.m