|
Last change
on this file was 628, checked in by George Lilly, 15 years ago |
|
initial load of FOIAVistA 6/30/08 version
|
|
File size:
854 bytes
|
| Line | |
|---|
| 1 | RMPFDD1 ;DDC/KAW-DETERMINE PATIENT'S DDC ELIGIBILITY; [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;;input: RMPFVET,RMPFDOD,RMPFELS,RMPFF (opt.)
|
|---|
| 4 | ;;output: RMPFE,RMPFTE
|
|---|
| 5 | ELIG S RMPFE="I",RMPFMSG="VALID ELIGIBILITY NOT IN DHCP PATIENT FILE"
|
|---|
| 6 | I RMPFVET="N" S RMPFMSG="PATIENT IS NOT A VETERAN"
|
|---|
| 7 | I RMPFDOD'="" S RMPFMSG="PATIENT IS DECEASED"
|
|---|
| 8 | I $D(RMPFELS),RMPFELS'?1"V".E S RMPFMSG="ELIGIBILITY NOT VERIFIED" G ELGE
|
|---|
| 9 | I RMPFVET="N" S X=0 F I=1:1 S X=$O(RMPFF(X)) Q:'X I RMPFF(X)["ALLIED"!(RMPFF(X)["OTHER GOV") S RMPFMSG=RMPFF(X),RMPFE="E" G ELGE
|
|---|
| 10 | I $D(RMPFF(1)) S RMPFMSG=RMPFF(1),RMPFE="E"
|
|---|
| 11 | ELGE S:RMPFE="I" RMPFTE=""
|
|---|
| 12 | W !!?23,"Patient is: ",$S(RMPFE="E":"ELIGIBLE",1:"ELIGIBILITY CANNOT BE DETERMINED")
|
|---|
| 13 | W ! W:RMPFE="E" ?2 W "Priority Reason for ",$S(RMPFE="E":"E",1:"Ine"),"ligibility: ",$E(RMPFMSG,1,44)
|
|---|
| 14 | END K RMPFMSG,X,I Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
