| 1 | RMPFETL1 ;DDC/KAW-CONTINUATION OF RMPFETL [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;; input: RMPFX,DFN
|
|---|
| 4 | ;;output: RMPFTE
|
|---|
| 5 | G END:$P(RMPFSYS,U,13)
|
|---|
| 6 | S SX=$G(^RMPF(791810,RMPFX,2)),SD=$P(SX,U,8) G START:'SD
|
|---|
| 7 | I $D(^RMPF(791810,"AF",SD,RMPFX)) W $C(7),!!,"*** Eligibility Determination Awaiting Processing in PSAS ***" G END
|
|---|
| 8 | START D ASK G END:$D(RMPFOUT),END:"Yy"'[Y
|
|---|
| 9 | D GETEL G END:$D(RMPFOUT)
|
|---|
| 10 | END S RMPFTE="" K RMPFOUT,RMPFQUT,SD,SX Q
|
|---|
| 11 | READ K RMPFOUT,RMPFQUT
|
|---|
| 12 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 13 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 14 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 15 | Q
|
|---|
| 16 | ASK ;;Request eligibility determination
|
|---|
| 17 | ;; input: None
|
|---|
| 18 | ;;output: Y
|
|---|
| 19 | W !!,"Request an Eligibility Determination from PSAS? YES// "
|
|---|
| 20 | D READ Q:$D(RMPFOUT)
|
|---|
| 21 | ASK1 I $D(RMPFQUT) W !!,"Enter a <Y> to submit a request for eligibility determination from PSAS",!?5,"an <N> or <RETURN> to exit." G ASK
|
|---|
| 22 | S:Y="" Y="Y" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G ASK1
|
|---|
| 23 | Q
|
|---|
| 24 | GETEL ;;Set up proposed eligibility fields
|
|---|
| 25 | ;; input: RMPFX
|
|---|
| 26 | ;;output: RMPFTE
|
|---|
| 27 | Q:'$D(DFN) Q:'DFN D PAT^RMPFUTL
|
|---|
| 28 | S DIC=791810.4,DIC(0)="AEQM",DIC("A")="Select Proposed Eligibility: " W ! D ^DIC G GETELE:Y=-1 S RMPFTE=+Y,RMPFELG=$P(Y,U,2)
|
|---|
| 29 | S X="NOW",%DT="T" D ^%DT S TD=Y
|
|---|
| 30 | S DIE="^RMPF(791810,",DA=RMPFX,DR="2.06////"_RMPFTE_";2.07////"_DUZ_";2.08////"_TD D ^DIE
|
|---|
| 31 | MAIL ;;Send message to PSAS mail group
|
|---|
| 32 | ;; input: RMPFELG,RMPFNAM
|
|---|
| 33 | ;;output:
|
|---|
| 34 | S MG=$O(^XMB(3.8,"B","RMPF ROES UPDATES (PSAS)",0))
|
|---|
| 35 | I 'MG W $C(7),!!,"*** MAIL GROUP RMPF ROES UPDATES (PSAS) NOT ESTABLISHED - NO MESSAGE SENT ***" G GETELE
|
|---|
| 36 | S XMY("G."_$P($G(^XMB(3.8,MG,0)),U,1))=""
|
|---|
| 37 | S XMSUB="ROES PATIENT ELIGIBILITY DETERMINATION REQUEST"
|
|---|
| 38 | S XMTEXT(1)="The Remote Order/Entry System requires that a patient be eligible"
|
|---|
| 39 | S XMTEXT(2)="to receive a hearing aid, batteries or hearing aid services."
|
|---|
| 40 | S XMTEXT(3)="An eligibility determination has been requested by ASPS for:"
|
|---|
| 41 | S XMTEXT(4)=" "
|
|---|
| 42 | S XMTEXT(5)=RMPFNAM_" SSN: "_RMPFSSN
|
|---|
| 43 | S XMTEXT(6)=" "
|
|---|
| 44 | S XMTEXT(7)="Proposed Eligibility: "_RMPFELG
|
|---|
| 45 | S XMTEXT="XMTEXT("
|
|---|
| 46 | D ^XMD W !!,"*** Message sent to PSAS Mail Group ***" H 2
|
|---|
| 47 | GETELE K DIC,DIE,DA,DR,D0,DI,DISYS,DQ,TD,%DT,X,Y,RMPFNAM,RMPFSSN,RMPFDOB
|
|---|
| 48 | K RMPFDOD,RMPFELG,XMZ,XMDUZ,XCNP,MG,D Q
|
|---|
