Routine: RMPRELG1

RMPRELG1 ;PHX/RFM/JLT-DISPLAY ELIGIBILITY FIRST PAGE ;8/29/1994

 ;;3.0;PROSTHETICS;**45**;Feb 09, 1996

 D HOME^%ZIS,DIV4^RMPRSIT  G:$D(X) EXIT S DIC(0)="AEMQ",DIC="^DPT(" D ^DIC G:Y<0 EXIT S DFN=+Y D DEM^VADPT S RMPRNAM=VADM(1),RMPRSSN=$P(VADM(2),U,2) K VADM D DEM^VADPT,ELIG^VADPT,ADD^VADPT,OAD^VADPT S RMPRCNUM=VAEL(7) W @IOF

 W $E(RMPRNAM,1,20),?23,"SSN: ",$P(VADM(2),U,2),?42,"DOB: ",$P(VADM(3),U,2),?61,"CLAIM# ",RMPRCNUM

 W !!,"Phone: ",VAPA(8),?40,"Phone: ",VAOA(8),!,"Current Address:",?40,"Primary Next of Kin Address:",!,VAPA(1),?40,VAOA(1)

 W:VAPA(2)'="" !,VAPA(2) W:VAPA(2)=""&(VAPA(3)'="") !,VAPA(3) W:VAPA(2)=""&(VAPA(3)="") !,VAPA(4),",",$P(VAPA(5),U,2)," ",VAPA(6)

 W:VAOA(4)'="" ?40,VAOA(4),",",$P(VAOA(5),U,2)," ",VAOA(6) W:VAPA(2)'=""&(VAPA(3)'="") !,VAPA(3),?40,"Name: ",VAOA(9) W:VAOA(2)'=""&(VAOA(3)="") !,VAPA(4),",",$P(VAPA(5),U,2)," ",VAPA(6)

 W:VAPA(2)=""&(VAPA(3)="")&(VAOA(9)'="") !?40,"Name: ",VAOA(9)

 W:VAPA(2)'=""&(VAPA(3)'="") !,VAPA(4),",",$P(VAPA(5),U,2)," ",VAPA(6),?40,"Relationship: ",VAPA(10)

 I VAOA(10)'="" W:VAPA(2)=""&(VAPA(3)'="")!(VAPA(2)="")&(VAPA(3)="") !?40,"Relationship: ",VAOA(10) K VAPA,VAOA

 W !!,"Patient Type: ",$P(VAEL(6),U,2),?40,"Period of Service: ",$P(VAEL(2),U,2),!,"Primary Eligibility Code:",?40,"Status: ",$P(VAEL(9),U,2),!,$P(VAEL(1),U,2)

 W ?40,"Eligibility Status: ",$E($P(VAEL(8),U,2),1,19) K VAEL D MB^VADPT W !!,"Receiving A&A Benefits? " W:VAMB(1)=0 "NO" W:$P(VAMB(1),U,1)=1 $P(VAMB(1),U,2)

 W ?40,"Receiving Housebound Benefits? " W:VAMB(2)=0 "NO" W:$P(VAMB(2),U,1)=1 $P(VAMB(2),U,2)

 W !,"Receiving Social Security? " W:VAMB(3)=0 "NO" W:$P(VAMB(3),U,1)=1 $P(VAMB(3),U,2) W ?40,"Receiving VA Pension? " W:VAMB(4)=0 "NO" W:$P(VAMB(4),U,1)=1 $P(VAMB(4),U,2)

 W !,"Receiving Military Retirement? " W:VAMB(5)=0 "NO" W:$P(VAMB(5),U,1)=1 $P(VAMB(5),U,2) W ?40,"Receiving VA Disability? " W:VAMB(7)=0 "NO" W:$P(VAMB(7),U,1)=1 $P(VAMB(7),U,2) K VAMB

 I $Y>18 D QUEST2 W @IOF

 S RO=0 F I=0:0 S RO=$O(^DPT(DFN,.372,RO)) W:'$D(RMPRL) !!,"Patient Name: ",VADM(1),?40,"SSN: ",$P(VADM(2),U,2),!!,"MAS Disability Code(s):" Q:RO'>0  D WRI

 D SVC^VADPT W !!,"*POW? ",$S(VASV(4)=1:"YES",VASV(4)=0:"NO") K VASV

 S FL=1 K RMNOQUIT G QUES

WRI ;WRITES MAS DISABILITY CODES

 I $Y>19 D QUEST1

 W !,$E($P(^DIC(31,$P(^DPT(DFN,.372,RO,0),U,1),0),U,1),1,30),?40,"Disability% ",$P(^DPT(DFN,.372,RO,0),U,2),?56," Service Connected? " W:$P(^DPT(DFN,.372,RO,0),U,3)=1 "YES" W:$P(^DPT(DFN,.372,RO,0),U,3)=0 "NO" S RMPRL=1 Q

 ;D:$P($G(^DPT(DFN,.372,RO,0)),U,1)>0&(RO'="")  Q

 ;.N RMPRTEM S RMPRTEM=$P(^DPT(DFN,.372,RO,0),U,1) I $P($G(^DIC(31,RMPRTEM,0)),U,1)="" W !!,"'",RMPRTEM,"'"," Is a non-existent code ; Check the MAS disability codes on this patient." S RMPRL=1 Q

 ;.W !,$E($P(^DIC(31,$P(^DPT(DFN,.372,RO,0),U,1),0),U,1),1,30),?40,"Disability% ",$P(^DPT(DFN,.372,RO,0),U,2),?56," Service Connected? " W:$P(^DPT(DFN,.372,RO,0),U,3)=1 "YES" W:$P(^DPT(DFN,.372,RO,0),U,3)=0 "NO" S RMPRL=1 Q

QUES K RMPRFLG,RMPRL F  Q:$Y>18  W !

 W ! R "Enter `^`to exit, or `return` to continue: ",ANS:DTIME G:'$T EXIT G:ANS="" ^RMPRELG2 G:ANS["^" EXIT

 W " ??",!!,$C(7) G QUES

EXIT ;KILL VARIABLES AND EXIT ROUTINE

 K FL,DIC,VA,RNSK D KVAR^VADPT

 K RMPRCNUM,RMPRCOMB,KILL,VAERR,VADM,VASV,VAOA,VAPA,FLG,ANS,DFN,RMPRDFN,RMPRDOB,RMPRNAM,RMPRSSN,Y

QUEST1 ;DO PAGE BREAK IF CURSOR AT LINE 18

 N DIR

W !

 S DIR(0)="FAO^0:0",DIR("A")="Enter `return` to continue" D ^DIR:DTIME

 I Y'="" W !,"YOU MUST ENTER `RETURN` TO FINISH VIEWING MAS DISABILITY CODES" G QUEST1

 W @IOF W !!,"Patient Name: ",$E(VADM(1),1,20),?40,"SSN:",$P(VADM(2),U,2),!!,"MAS Disability Codes continued: "

QUEST2 ;PRINT MAS DISABILITY CODES ON NEXT PAGE IF TOO MANY TO ALL FIT.

 N DIR K DIR S DIR(0)="FAO^0:0" D ^DIR:DTIME

 Q:'$T

 S RMNOQUIT=1

 I X="^" S RMNOQUIT=0 Q

 I X'="" W !,"Press `RETURN` to continue." G QUEST2

 I X="" W @IOF S RMNOQUIT=1 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRELG1   3891     printed  Mar 13, 2025@21:39:15                                                                                                                                                                                                    Page 2

RMPRELG1  ;PHX/RFM/JLT-DISPLAY ELIGIBILITY FIRST PAGE ;8/29/1994

 +1       ;;3.0;PROSTHETICS;**45**;Feb 09, 1996

 +2        DO HOME^%ZIS

           DO DIV4^RMPRSIT

           if $DATA(X)

               GOTO EXIT

           SET DIC(0)="AEMQ"

           SET DIC="^DPT("

           DO ^DIC

           if Y<0

               GOTO EXIT

           SET DFN=+Y

           DO DEM^VADPT

           SET RMPRNAM=VADM(1)

           SET RMPRSSN=$PIECE(VADM(2),U,2)

           KILL VADM

           DO DEM^VADPT

           DO ELIG^VADPT

           DO ADD^VADPT

           DO OAD^VADPT

           SET RMPRCNUM=VAEL(7)

           WRITE @IOF

 +3        WRITE $EXTRACT(RMPRNAM,1,20),?23,"SSN: ",$PIECE(VADM(2),U,2),?42,"DOB: ",$PIECE(VADM(3),U,2),?61,"CLAIM# ",RMPRCNUM

 +4        WRITE !!,"Phone: ",VAPA(8),?40,"Phone: ",VAOA(8),!,"Current Address:",?40,"Primary Next of Kin Address:",!,VAPA(1),?40,VAOA(1)

 +5        if VAPA(2)'=""

               WRITE !,VAPA(2)

           if VAPA(2)=""&(VAPA(3)'="")

               WRITE !,VAPA(3)

           if VAPA(2)=""&(VAPA(3)="")

               WRITE !,VAPA(4),",",$PIECE(VAPA(5),U,2)," ",VAPA(6)

 +6        if VAOA(4)'=""

               WRITE ?40,VAOA(4),",",$PIECE(VAOA(5),U,2)," ",VAOA(6)

           if VAPA(2)'=""&(VAPA(3)'="")

               WRITE !,VAPA(3),?40,"Name: ",VAOA(9)

           if VAOA(2)'=""&(VAOA(3)="")

               WRITE !,VAPA(4),",",$PIECE(VAPA(5),U,2)," ",VAPA(6)

 +7        if VAPA(2)=""&(VAPA(3)="")&(VAOA(9)'="")

               WRITE !?40,"Name: ",VAOA(9)

 +8        if VAPA(2)'=""&(VAPA(3)'="")

               WRITE !,VAPA(4),",",$PIECE(VAPA(5),U,2)," ",VAPA(6),?40,"Relationship: ",VAPA(10)

 +9        IF VAOA(10)'=""

               if VAPA(2)=""&(VAPA(3)'="")!(VAPA(2)="")&(VAPA(3)="")

                   WRITE !?40,"Relationship: ",VAOA(10)

               KILL VAPA,VAOA

 +10       WRITE !!,"Patient Type: ",$PIECE(VAEL(6),U,2),?40,"Period of Service: ",$PIECE(VAEL(2),U,2),!,"Primary Eligibility Code:",?40,"Status: ",$PIECE(VAEL(9),U,2),!,$PIECE(VAEL(1),U,2)

 +11       WRITE ?40,"Eligibility Status: ",$EXTRACT($PIECE(VAEL(8),U,2),1,19)

           KILL VAEL

           DO MB^VADPT

           WRITE !!,"Receiving A&A Benefits? "

           if VAMB(1)=0

               WRITE "NO"

           if $PIECE(VAMB(1),U,1)=1

               WRITE $PIECE(VAMB(1),U,2)

 +12       WRITE ?40,"Receiving Housebound Benefits? "

           if VAMB(2)=0

               WRITE "NO"

           if $PIECE(VAMB(2),U,1)=1

               WRITE $PIECE(VAMB(2),U,2)

 +13       WRITE !,"Receiving Social Security? "

           if VAMB(3)=0

               WRITE "NO"

           if $PIECE(VAMB(3),U,1)=1

               WRITE $PIECE(VAMB(3),U,2)

           WRITE ?40,"Receiving VA Pension? "

           if VAMB(4)=0

               WRITE "NO"

           if $PIECE(VAMB(4),U,1)=1

               WRITE $PIECE(VAMB(4),U,2)

 +14       WRITE !,"Receiving Military Retirement? "

           if VAMB(5)=0

               WRITE "NO"

           if $PIECE(VAMB(5),U,1)=1

               WRITE $PIECE(VAMB(5),U,2)

           WRITE ?40,"Receiving VA Disability? "

           if VAMB(7)=0

               WRITE "NO"

           if $PIECE(VAMB(7),U,1)=1

               WRITE $PIECE(VAMB(7),U,2)

           KILL VAMB

 +15       IF $Y>18

               DO QUEST2

               WRITE @IOF

 +16       SET RO=0

           FOR I=0:0

               SET RO=$ORDER(^DPT(DFN,.372,RO))

               if '$DATA(RMPRL)

                   WRITE !!,"Patient Name: ",VADM(1),?40,"SSN: ",$PIECE(VADM(2),U,2),!!,"MAS Disability Code(s):"

               if RO'>0

                   QUIT

               DO WRI

 +17       DO SVC^VADPT

           WRITE !!,"*POW? ",$SELECT(VASV(4)=1:"YES",VASV(4)=0:"NO")

           KILL VASV

 +18       SET FL=1

           KILL RMNOQUIT

           GOTO QUES

WRI       ;WRITES MAS DISABILITY CODES

 +1        IF $Y>19

               DO QUEST1

 +2        WRITE !,$EXTRACT($PIECE(^DIC(31,$PIECE(^DPT(DFN,.372,RO,0),U,1),0),U,1),1,30),?40,"Disability% ",$PIECE(^DPT(DFN,.372,RO,0),U,2),?56," Service Connected? "

           if $PIECE(^DPT(DFN,.372,RO,0),U,3)=1

               WRITE "YES"

           if $PIECE(^DPT(DFN,.372,RO,0),U,3)=0

               WRITE "NO"

           SET RMPRL=1

           QUIT

 +3       ;D:$P($G(^DPT(DFN,.372,RO,0)),U,1)>0&(RO'="")  Q

 +4       ;.N RMPRTEM S RMPRTEM=$P(^DPT(DFN,.372,RO,0),U,1) I $P($G(^DIC(31,RMPRTEM,0)),U,1)="" W !!,"'",RMPRTEM,"'"," Is a non-existent code ; Check the MAS disability codes on this patient." S RMPRL=1 Q

 +5       ;.W !,$E($P(^DIC(31,$P(^DPT(DFN,.372,RO,0),U,1),0),U,1),1,30),?40,"Disability% ",$P(^DPT(DFN,.372,RO,0),U,2),?56," Service Connected? " W:$P(^DPT(DFN,.372,RO,0),U,3)=1 "YES" W:$P(^DPT(DFN,.372,RO,0),U,3)=0 "NO" S RMPRL=1 Q

QUES       KILL RMPRFLG,RMPRL

FOR

               if $Y>18

                   QUIT

               WRITE !

 +1        WRITE !

           READ "Enter `^`to exit, or `return` to continue: ",ANS:DTIME

           if '$TEST

               GOTO EXIT

           if ANS=""

               GOTO ^RMPRELG2

           if ANS["^"

               GOTO EXIT

 +2        WRITE " ??",!!,$CHAR(7)

           GOTO QUES

EXIT      ;KILL VARIABLES AND EXIT ROUTINE

 +1        KILL FL,DIC,VA,RNSK

           DO KVAR^VADPT

 +2        KILL RMPRCNUM,RMPRCOMB,KILL,VAERR,VADM,VASV,VAOA,VAPA,FLG,ANS,DFN,RMPRDFN,RMPRDOB,RMPRNAM,RMPRSSN,Y

 +3        QUIT

QUEST1    ;DO PAGE BREAK IF CURSOR AT LINE 18

 +1        NEW DIR

 +2        WRITE !

 +3        SET DIR(0)="FAO^0:0"

           SET DIR("A")="Enter `return` to continue"

           if DTIME

               DO ^DIR

 +4        IF Y'=""

               WRITE !,"YOU MUST ENTER `RETURN` TO FINISH VIEWING MAS DISABILITY CODES"

               GOTO QUEST1

 +5        WRITE @IOF

           WRITE !!,"Patient Name: ",$EXTRACT(VADM(1),1,20),?40,"SSN:",$PIECE(VADM(2),U,2),!!,"MAS Disability Codes continued: "

 +6        QUIT

QUEST2    ;PRINT MAS DISABILITY CODES ON NEXT PAGE IF TOO MANY TO ALL FIT.

 +1        NEW DIR

           KILL DIR

           SET DIR(0)="FAO^0:0"

           if DTIME

               DO ^DIR

 +2        if '$TEST

               QUIT

 +3        SET RMNOQUIT=1

 +4        IF X="^"

               SET RMNOQUIT=0

               QUIT

 +5        IF X'=""

               WRITE !,"Press `RETURN` to continue."

               GOTO QUEST2

 +6        IF X=""

               WRITE @IOF

               SET RMNOQUIT=1

               QUIT

RMPRELG1.m