source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDD3.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 866 bytes
Line 
1RMPFDD3 ;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."
10E0 W !!,"Do you wish to enter an eligibility? YES// "
11 D READ G END:$D(RMPFOUT)
12E01 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
15E1 W ! S DIC=791810.4,DIC(0)="AEQM" D ^DIC G END:Y=-1
16 S RMPFELG=+Y,RMPFELGD=$P(Y,U,2)
17END Q
18READ 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
Note: See TracBrowser for help on using the repository browser.