| 1 | RMPFDE3 ;DDC/PJU - RE ELIGIBILITY APPROVAL PROCESS ;7/8/04
|
|---|
| 2 | ;;3.0;REMOTE ORDER/ENTRY SYSTEM;**1**;11/1/02
|
|---|
| 3 | ;CALLED DURING OPTION RMPFDE2 TO PROCESS PENDING ELIGIBILITIES
|
|---|
| 4 | DISPLINE ;
|
|---|
| 5 | ;RMPFX=req dt^pat name^pat SSN^sug el^dfn^req DUZ^MSG #
|
|---|
| 6 | N EL,I,IEN,NM,RD,RMMSG,RMPFOUT,RMPFQUT,RMPFSEL,RO,RQ,SSN,X,Y
|
|---|
| 7 | S RD=$P(RMPFX,U,1),NM=$P(RMPFX,U,2),SSN=$P(RMPFX,U,3)
|
|---|
| 8 | S EL=$P(RMPFX,U,4),RQ=$P(RMPFX,U,6),RMMSG=$P(RMPFX,U,7)
|
|---|
| 9 | S IEN=$P(RMPFX,U,8),RO=0
|
|---|
| 10 | W !!!,?4,$$FMTE^XLFDT(RD),?24,NM
|
|---|
| 11 | W ?43,$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,$L(SSN)),?56,EL
|
|---|
| 12 | W ! F I=1:1:80 W "-"
|
|---|
| 13 | W !?13,"Proposed Eligibility: ",EL
|
|---|
| 14 | W !?23,"Entered By: ",$S(RQ:$P($G(^VA(200,RQ,0)),U,1),1:"UNKNOWN")
|
|---|
| 15 | I RMMSG,$D(^XMB(3.9,RMMSG,2))>9 D
|
|---|
| 16 | .W !?4,"Comments: " S I=6 F S I=$O(^XMB(3.9,RMMSG,2,I)) Q:'I D
|
|---|
| 17 | ..W !,^XMB(3.9,RMMSG,2,I,0)
|
|---|
| 18 | A0 W !!,"<A>ccept, <E>dit, <R>eject or <RETURN> to listing: "
|
|---|
| 19 | D:$G(RMPFVFLG)=1 READ^RMPFDE2 G END:$D(RMPFOUT)
|
|---|
| 20 | A1 I $D(RMPFQUT) D G A0
|
|---|
| 21 | .W !!,"Enter an <A> to accept the proposed eligibility"
|
|---|
| 22 | .W !?6,"an <E> to change to an acceptable eligibility"
|
|---|
| 23 | .W !?6,"an <R> to reject the request back to ASPS or"
|
|---|
| 24 | .W !?7,"a <RETURN> to exit back to the list."
|
|---|
| 25 | G END:Y=""
|
|---|
| 26 | S RMPFSEL=$E(Y,1),RMPFSEL=$$UP^XLFSTR(RMPFSEL)
|
|---|
| 27 | S EL=$TR(EL," ","")
|
|---|
| 28 | I "AER"'[RMPFSEL S RMPFQUT="" G A1
|
|---|
| 29 | S DIE="^RMPF(791814,",DA=IEN K DR
|
|---|
| 30 | I "AR"[RMPFSEL D D:'RO MAIL D:RO MSG G END
|
|---|
| 31 | .I EL="",RMPFSEL="A" S RO=1 Q
|
|---|
| 32 | .S DR=".04///"_$$FMADD^XLFDT(DT,730) ; 730 days to expire (2 yrs)
|
|---|
| 33 | .S DR=DR_";2.01////"_EL_";2.03////"_DUZ_";2.04////"_DT
|
|---|
| 34 | .I RMPFSEL="A" S DR=DR_";2.02////1"
|
|---|
| 35 | .E S DR=DR_";2.02////0" ;reject
|
|---|
| 36 | .D ^DIE
|
|---|
| 37 | I "Ee"[RMPFSEL D G:$D(RMPFOUT) END D:'RO MAIL D:RO MSG G END
|
|---|
| 38 | .W !
|
|---|
| 39 | .F X=1:1:18 W !,X,?4,$P($T(@X),";;",2),?15,$P($T(@X),";;",3) ;list eligibilities
|
|---|
| 40 | A2 .S Y=""
|
|---|
| 41 | .W !!,"Enter the line number of the preferred eligibility: "
|
|---|
| 42 | .D:$G(RMPFVFLG)=1 READ^RMPFDE2
|
|---|
| 43 | .G:$D(RMPFQUT) A2 Q:$D(RMPFOUT)
|
|---|
| 44 | .I (Y<1)!(Y>18) S RO=1 Q
|
|---|
| 45 | .S EL=$P($T(@Y),";;",2) I EL="" S RO=1 Q
|
|---|
| 46 | .S DR=".04///"_$$FMADD^XLFDT(DT,730) ;730 days to expire (2 yrs)
|
|---|
| 47 | .S DR=DR_";2.01////"_EL_";2.03////"_DUZ_";2.04////"_DT
|
|---|
| 48 | .S DR=DR_";2.02////1" ;accept selected elig
|
|---|
| 49 | .D ^DIE K DR
|
|---|
| 50 | END K DIE,DR,DA Q
|
|---|
| 51 | ;
|
|---|
| 52 | MSG W !!,"*** No eligibility was selected. ***" R X:5 Q
|
|---|
| 53 | ;
|
|---|
| 54 | MAIL ;;Send message to ASPS mail group
|
|---|
| 55 | ;; input: EL,NM,SSN
|
|---|
| 56 | ;;output: XMZ
|
|---|
| 57 | S XMZ=""
|
|---|
| 58 | S MG=$O(^XMB(3.8,"B","RMPF ROES UPDATES (ASPS)",0))
|
|---|
| 59 | I 'MG D G MAILE
|
|---|
| 60 | .W $C(7),!!,"*** MAIL GROUP - RMPF ROES UPDATES (ASPS) - NOT ESTABLISHED - NO MESSAGE SENT ***"
|
|---|
| 61 | S XMY("G."_$P($G(^XMB(3.8,MG,0)),U,1))=""
|
|---|
| 62 | S MG=$O(^XMB(3.8,"B","RMPF ROES UPDATES (PSAS)",0))
|
|---|
| 63 | I 'MG W $C(7),!!,"*** MAIL GROUP - RMPF ROES UPDATES (PSAS) - NOT ESTABLISHED ***"
|
|---|
| 64 | E S XMY("G."_$P($G(^XMB(3.8,MG,0)),U,1))=""
|
|---|
| 65 | S XMY(DUZ)=""
|
|---|
| 66 | S XMSUB="ROES PATIENT ELIGIBILITY UPDATE"
|
|---|
| 67 | S XMDUZ=DUZ
|
|---|
| 68 | D XMZ^XMA2 I XMZ<1 D G MAILE
|
|---|
| 69 | .W !!,"*** MAIL Msg not created! Eligibility not updated! ***"
|
|---|
| 70 | S XMTEXT(1)="ROES Patient Eligibility has been updated for the following patient:"
|
|---|
| 71 | S XMTEXT(2)=" "
|
|---|
| 72 | S XMTEXT(3)=NM_" "_SSN
|
|---|
| 73 | S XMTEXT(4)=" "
|
|---|
| 74 | S XMTEXT(5)="Eligibility: "_EL
|
|---|
| 75 | S XMTEXT(6)=" "
|
|---|
| 76 | S X="" S:$D(^RMPF(791814,IEN,2)) X=$P(^(2),U,2) S X=$S(X=1:"Has been Accepted",X=0:"Has been Rejected",1:"Is Waiting processing")
|
|---|
| 77 | S XMTEXT(7)="Comment: "_X
|
|---|
| 78 | S XMTEXT="XMTEXT("
|
|---|
| 79 | D ^XMD W !!,"*** Message sent to user and Mail Group ***" H 2
|
|---|
| 80 | MAILE K MG,XMTEXT,XMDUZ,XMSUB,XMY
|
|---|
| 81 | Q
|
|---|
| 82 | ELGLIST ;;LIST THE POSSIBILE ELIGIBILITIES
|
|---|
| 83 | 1 ;;SC;;Service Connected for Hearing Loss
|
|---|
| 84 | 2 ;;COM;;10 to 100 PerCent Service Connected Disability
|
|---|
| 85 | 3 ;;EP3;;Enrollment Priority Group 3 (PH, etc.)
|
|---|
| 86 | 4 ;;POW;;Prisoner of War
|
|---|
| 87 | 5 ;;AAA;;Aid and Attendance
|
|---|
| 88 | 6 ;;HB;;Housebound
|
|---|
| 89 | 7 ;;0CA;;0 PerCent SC and Priority Groups 5 or 7a
|
|---|
| 90 | 8 ;;NCA;;NSC_Pension or (NSC and Prioity Groups 5)
|
|---|
| 91 | 9 ;;SCV;;Special Category Veterans in Priority Group 6
|
|---|
| 92 | 10 ;;CAN;;Canadian Vet
|
|---|
| 93 | 11 ;;BRI;;Great Britain Vet
|
|---|
| 94 | 12 ;;WWI;;World War I or Mexican Border War
|
|---|
| 95 | 13 ;;NSC;;NSC and Priority Group 7c
|
|---|
| 96 | 14 ;;BLR;;Blind Rehab
|
|---|
| 97 | 15 ;;VOC;;Vocational Rehab
|
|---|
| 98 | 16 ;;OGA;;Other Approved Federal Agencies
|
|---|
| 99 | 17 ;;PG8;;Priority Group 8 (pays co-pay)
|
|---|
| 100 | 18 ;;PG4;;Catastrophic Disability
|
|---|
