source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFETL1.m@ 810

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1RMPFETL1 ;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
8START D ASK G END:$D(RMPFOUT),END:"Yy"'[Y
9 D GETEL G END:$D(RMPFOUT)
10END S RMPFTE="" K RMPFOUT,RMPFQUT,SD,SX Q
11READ 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
16ASK ;;Request eligibility determination
17 ;; input: None
18 ;;output: Y
19 W !!,"Request an Eligibility Determination from PSAS? YES// "
20 D READ Q:$D(RMPFOUT)
21ASK1 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
24GETEL ;;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
31MAIL ;;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
47GETELE 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
Note: See TracBrowser for help on using the repository browser.