| 1 | RMPFDD ;DDC/KAW-PATIENT INFORMATION DISPLAY; [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
|
|---|
| 4 | I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
|
|---|
| 5 | W @IOF,!,"PATIENT INFORMATION DISPLAY",!!
|
|---|
| 6 | PAT S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y
|
|---|
| 7 | CON D DISP,CONT G END:$D(RMPFOUT),CON:$D(RMPFQUT),RMPFSET:Y=""
|
|---|
| 8 | D QUE:"Pp"[Y G CON:'$D(ZTSK),RMPFSET
|
|---|
| 9 | END K ZTSK,DFN,RMPFE,RMPFTE,RMPFOUT,RMPFQUT,DIC,X,I,A,J,Y,%,%Y,%XX,%YY,POP
|
|---|
| 10 | Q
|
|---|
| 11 | DISP ;; input: DFN
|
|---|
| 12 | ;;output: RMPFE,RMPFTE
|
|---|
| 13 | Q:'$D(DFN) D ^RMPFDD2,HEAD
|
|---|
| 14 | W:RMPFVET="N" $C(7),!?23,"*** PATIENT IS NOT A VETERAN ***",!
|
|---|
| 15 | I RMPFDOD'="" W $C(7),!?26,"*** PATIENT IS DECEASED ***"
|
|---|
| 16 | W !?6,"Name: ",RMPFNAM,?49,"SSN: ",RMPFSSN
|
|---|
| 17 | W !?7,"DOB: ",RMPFDOB
|
|---|
| 18 | I $D(RMPFCL),RMPFCL'="" W ?45,"Claim #: ",$J(RMPFCL,11)
|
|---|
| 19 | I RMPFDOD'="" W !?7,"DOD: ",RMPFDOD
|
|---|
| 20 | W !!?3,"Address: " G ELG0:'$D(RMPFA(1)) W RMPFA(1) K RMPFT
|
|---|
| 21 | I RMPFTSD=""&(RMPFTED="") K RMPFTSD,RMPFTED
|
|---|
| 22 | I $D(RMPFTSD) W ?42,"Start Date: ",RMPFTSD
|
|---|
| 23 | F I=2:1 Q:'$D(RMPFA(I)) W !?12,$S($D(RMPFA(I)):RMPFA(I),1:"") I $D(RMPFTED) W ?44,"End Date: ",RMPFTED K RMPFTED
|
|---|
| 24 | W !?5,"Phone: ",RMPFONE I $D(RMPFTED) W ?44,"End Date: ",RMPFTED
|
|---|
| 25 | ELG0 W ! F I=1:1:80 W "-"
|
|---|
| 26 | W !!?5,"*** DHCP PATIENT FILE DETERMINATION OF ELIGIBILITY FOR ROES ORDERS ***"
|
|---|
| 27 | G ELG1:'$D(RMPFF) W !!?1,"Veteran Eligibilities: " S (X,C)=0
|
|---|
| 28 | F II=1:1 S X=$O(RMPFF(X)) Q:'X W:II>1 ! W ?24,RMPFF(X) W:II=1&$D(RMPFELS) ?57,$J(RMPFELS,23) W:II=2&$D(RMPFELGD) ?68,$J(RMPFELGD,12)
|
|---|
| 29 | I I=2 W:$D(RMPFELGD) !?68,$J(RMPFELGD,12)
|
|---|
| 30 | ELG1 D ^RMPFDD1
|
|---|
| 31 | I $D(RMPFF(1)),RMPFF(1)["ALLIED VETERAN" W $C(7),!!?7,"*** An Allied Veteran Agreement must be on file at the DDC. ***"
|
|---|
| 32 | I $D(RMPFF(1)),RMPFF(1)="AID & ATTENDANCE"!(RMPFF(1)="HOUSEBOUND") W $C(7),!!,"*** This eligibility is subject to change. Be sure verification is recent. ***"
|
|---|
| 33 | I IOST?1"P-".E W @IOF
|
|---|
| 34 | D:$D(IO("S")) ^%ZISC
|
|---|
| 35 | QUIT K RMPFVET,RMPFDOD,RMPFCL,RMPFTSD,RMPFTED,RMPFELG,RMPFELGD,RMPFELP
|
|---|
| 36 | K RMPFDOB,RMPFELS,RMPFNAM,RMPFSSN,RMPFELD,RMPFA,RMPFL,RMPFT,RMPFF
|
|---|
| 37 | K RMPFONE,S0,S1,S2,S6,ST,II,C,I,N,P,S,T K X,Y,Z Q
|
|---|
| 38 | CONT F I=1:1 Q:$Y>22 W !
|
|---|
| 39 | W !,"Enter <RETURN> to continue or <P>rint: " D READ
|
|---|
| 40 | I $D(RMPFQUT) D MSG G CONT
|
|---|
| 41 | Q:Y="" S Y=$E(Y,1) I "Pp"'[Y G CONT
|
|---|
| 42 | Q
|
|---|
| 43 | QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
|
|---|
| 44 | I IO=IO(0),'$D(IO("S")) K ZTSK Q
|
|---|
| 45 | I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G DISP^RMPFDD
|
|---|
| 46 | S ZTRTN="DISP^RMPFDD",ZTDESC="PATIENT INFORMATION",ZTIO=ION
|
|---|
| 47 | S ZTSAVE("RMPF*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
|
|---|
| 48 | D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
|
|---|
| 49 | K %T,POP Q
|
|---|
| 50 | HEAD W:'$D(ZTSK) @IOF
|
|---|
| 51 | W !?20,"REMOTE ORDER/ENTRY PATIENT INFORMATION"
|
|---|
| 52 | W !,"Station: ",RMPFSTAP,?68,RMPFDAT,!
|
|---|
| 53 | F I=1:1:80 W "-"
|
|---|
| 54 | Q
|
|---|
| 55 | READ K RMPFOUT,RMPFQUT
|
|---|
| 56 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 57 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 58 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 59 | Q
|
|---|
| 60 | MSG W !!,"Enter <P> to print the screen"
|
|---|
| 61 | W !?6,"<RETURN> to continue.",!
|
|---|
| 62 | Q
|
|---|
