| [613] | 1 | RMPFDD3 ;DDC/KAW-ENTER/EDIT ELIGIBILITY [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;; input: DFN
|
|---|
| 4 | ;;output:
|
|---|
| 5 | D PAT^RMPFUTL
|
|---|
| 6 | W @IOF,!?29,"ENTER/EDIT ELIGIBILITY"
|
|---|
| 7 | W !!,"Patient: ",RMPFNAM,?40,"SSN: ",RMPFSSN,?63,RMPFDOB,!
|
|---|
| 8 | F I=1:1:79 W "-"
|
|---|
| 9 | W !!,"Eligibility for ROES transactions cannot be determined from the DHCP database",!,"for this veteran."
|
|---|
| 10 | E0 W !!,"Do you wish to enter an eligibility? YES// "
|
|---|
| 11 | D READ G END:$D(RMPFOUT)
|
|---|
| 12 | 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
|
|---|
| 13 | S:Y="" Y="Y" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G E01
|
|---|
| 14 | G END:"Nn"[Y
|
|---|
| 15 | E1 W ! S DIC=791810.4,DIC(0)="AEQM" D ^DIC G END:Y=-1
|
|---|
| 16 | S RMPFELG=+Y,RMPFELGD=$P(Y,U,2)
|
|---|
| 17 | END Q
|
|---|
| 18 | READ K RMPFOUT,RMPFQUT
|
|---|
| 19 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 20 | I Y?1U.E S (RMPFOUT,Y)="" Q
|
|---|
| 21 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 22 | Q
|
|---|
