49 lines
2.2 KiB
Mathematica
49 lines
2.2 KiB
Mathematica
RMPFETL1 ;DDC/KAW-CONTINUATION OF RMPFETL [ 06/16/95 3:06 PM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|
;; input: RMPFX,DFN
|
|
;;output: RMPFTE
|
|
G END:$P(RMPFSYS,U,13)
|
|
S SX=$G(^RMPF(791810,RMPFX,2)),SD=$P(SX,U,8) G START:'SD
|
|
I $D(^RMPF(791810,"AF",SD,RMPFX)) W $C(7),!!,"*** Eligibility Determination Awaiting Processing in PSAS ***" G END
|
|
START D ASK G END:$D(RMPFOUT),END:"Yy"'[Y
|
|
D GETEL G END:$D(RMPFOUT)
|
|
END S RMPFTE="" K RMPFOUT,RMPFQUT,SD,SX Q
|
|
READ K RMPFOUT,RMPFQUT
|
|
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|
I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|
S:Y?1"?".E (RMPFQUT,Y)=""
|
|
Q
|
|
ASK ;;Request eligibility determination
|
|
;; input: None
|
|
;;output: Y
|
|
W !!,"Request an Eligibility Determination from PSAS? YES// "
|
|
D READ Q:$D(RMPFOUT)
|
|
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
|
|
S:Y="" Y="Y" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G ASK1
|
|
Q
|
|
GETEL ;;Set up proposed eligibility fields
|
|
;; input: RMPFX
|
|
;;output: RMPFTE
|
|
Q:'$D(DFN) Q:'DFN D PAT^RMPFUTL
|
|
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)
|
|
S X="NOW",%DT="T" D ^%DT S TD=Y
|
|
S DIE="^RMPF(791810,",DA=RMPFX,DR="2.06////"_RMPFTE_";2.07////"_DUZ_";2.08////"_TD D ^DIE
|
|
MAIL ;;Send message to PSAS mail group
|
|
;; input: RMPFELG,RMPFNAM
|
|
;;output:
|
|
S MG=$O(^XMB(3.8,"B","RMPF ROES UPDATES (PSAS)",0))
|
|
I 'MG W $C(7),!!,"*** MAIL GROUP RMPF ROES UPDATES (PSAS) NOT ESTABLISHED - NO MESSAGE SENT ***" G GETELE
|
|
S XMY("G."_$P($G(^XMB(3.8,MG,0)),U,1))=""
|
|
S XMSUB="ROES PATIENT ELIGIBILITY DETERMINATION REQUEST"
|
|
S XMTEXT(1)="The Remote Order/Entry System requires that a patient be eligible"
|
|
S XMTEXT(2)="to receive a hearing aid, batteries or hearing aid services."
|
|
S XMTEXT(3)="An eligibility determination has been requested by ASPS for:"
|
|
S XMTEXT(4)=" "
|
|
S XMTEXT(5)=RMPFNAM_" SSN: "_RMPFSSN
|
|
S XMTEXT(6)=" "
|
|
S XMTEXT(7)="Proposed Eligibility: "_RMPFELG
|
|
S XMTEXT="XMTEXT("
|
|
D ^XMD W !!,"*** Message sent to PSAS Mail Group ***" H 2
|
|
GETELE K DIC,DIE,DA,DR,D0,DI,DISYS,DQ,TD,%DT,X,Y,RMPFNAM,RMPFSSN,RMPFDOB
|
|
K RMPFDOD,RMPFELG,XMZ,XMDUZ,XCNP,MG,D Q
|