Routine: RMPFDD3

RMPFDD3 ;DDC/KAW-ENTER/EDIT ELIGIBILITY [ 06/16/95   3:06 PM ]

 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995

 ;; input: DFN

 ;;output:

 D PAT^RMPFUTL

 W @IOF,!?29,"ENTER/EDIT ELIGIBILITY"

 W !!,"Patient: ",RMPFNAM,?40,"SSN: ",RMPFSSN,?63,RMPFDOB,!

 F I=1:1:79 W "-"

 W !!,"Eligibility for ROES transactions cannot be determined from the DHCP database",!,"for this veteran."

E0 W !!,"Do you wish to enter an eligibility? YES// "

 D READ G END:$D(RMPFOUT)

E01 I $D(RMPFQUT) W !!,"Enter a <Y> if you wish to select an eligibility",!?6,"a <N> if you wish to exit" G E0

 S:Y="" Y="Y" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G E01

 G END:"Nn"[Y

E1 W ! S DIC=791810.4,DIC(0)="AEQM" D ^DIC G END:Y=-1

 S RMPFELG=+Y,RMPFELGD=$P(Y,U,2)

END Q

READ K RMPFOUT,RMPFQUT

 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U

 I Y?1U.E S (RMPFOUT,Y)="" Q

 S:Y?1"?".E (RMPFQUT,Y)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDD3   888     printed  Mar 13, 2025@21:40:50                                                                                                                                                                                                      Page 2

RMPFDD3   ;DDC/KAW-ENTER/EDIT ELIGIBILITY [ 06/16/95   3:06 PM ]

 +1       ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995

 +2       ;; input: DFN

 +3       ;;output:

 +4        DO PAT^RMPFUTL

 +5        WRITE @IOF,!?29,"ENTER/EDIT ELIGIBILITY"

 +6        WRITE !!,"Patient: ",RMPFNAM,?40,"SSN: ",RMPFSSN,?63,RMPFDOB,!

 +7        FOR I=1:1:79

               WRITE "-"

 +8        WRITE !!,"Eligibility for ROES transactions cannot be determined from the DHCP database",!,"for this veteran."

E0         WRITE !!,"Do you wish to enter an eligibility? YES// "

 +1        DO READ

           if $DATA(RMPFOUT)

               GOTO END

E01        IF $DATA(RMPFQUT)

               WRITE !!,"Enter a <Y> if you wish to select an eligibility",!?6,"a <N> if you wish to exit"

               GOTO E0

 +1        if Y=""

               SET Y="Y"

           SET Y=$EXTRACT(Y,1)

           IF "YyNn"'[Y

               SET RMPFQUT=""

               GOTO E01

 +2        if "Nn"[Y

               GOTO END

E1         WRITE !

           SET DIC=791810.4

           SET DIC(0)="AEQM"

           DO ^DIC

           if Y=-1

               GOTO END

 +1        SET RMPFELG=+Y

           SET RMPFELGD=$PIECE(Y,U,2)

END        QUIT

READ       KILL RMPFOUT,RMPFQUT

 +1        READ Y:DTIME

           IF '$TEST

               WRITE $CHAR(7)

               READ Y:5

               if Y="."

                   GOTO READ

               if '$TEST

                   SET Y=U

 +2        IF Y?1U.E

               SET (RMPFOUT,Y)=""

               QUIT

 +3        if Y?1"?".E

               SET (RMPFQUT,Y)=""

 +4        QUIT

RMPFDD3.m