| 1 | RMPFRPC3 ;DDC/PJU - ROES3 ELIGIBILITY MESSAGES ;11/01/02
|
|---|
| 2 | ;;3.0;REMOTE ORDER ENTRY SYSTEM;;11/01/02
|
|---|
| 3 | START(RE,DUZ,GRP,SUBJ,RMPFARR) ;ELIG MSGS;
|
|---|
| 4 | ;RE WILL RETURN 1 if OK, 0 if error and XMZ if mail msg sent
|
|---|
| 5 | ;DUZ OF USER
|
|---|
| 6 | ;MAIL GROUP RECEIVING
|
|---|
| 7 | ;SUBJECT LINE
|
|---|
| 8 | ;ARRAY OF TEXT LINES FOR MSG
|
|---|
| 9 | N CT,XMZ,EL,AP,SSN,SG,DFN S RE=1,(AP,EL,SG,SSN,DFN)=""
|
|---|
| 10 | SEND D KILL^XM
|
|---|
| 11 | S CT=0 F S CT=$O(RMPFARR(CT)) Q:'CT D
|
|---|
| 12 | .S:$P(RMPFARR(CT)," ",1)="Eligibility:" EL=$P(RMPFARR(CT),":",2),EL=$$TRIM^XLFSTR(EL)
|
|---|
| 13 | .S:$P(RMPFARR(CT)," ",1)="SSN:" SSN=$P(RMPFARR(CT),":",2),SSN=$$TRIM^XLFSTR(SSN)
|
|---|
| 14 | .S:$P(RMPFARR(CT),":",1)="Suggested Eligibility" SG=$P($G(RMPFARR(CT)),":",2),SG=$$TRIM^XLFSTR(SG)
|
|---|
| 15 | .S:$P(RMPFARR(CT)," ",1)="Request:" AP=$P(RMPFARR(CT),":",2),AP=$$TRIM^XLFSTR(AP) ;approved/disapproved
|
|---|
| 16 | S XMSUB=SUBJ
|
|---|
| 17 | S XMDUZ=DUZ
|
|---|
| 18 | D XMZ^XMA2
|
|---|
| 19 | I XMZ<0 S RE=0 G END
|
|---|
| 20 | S RE=XMZ
|
|---|
| 21 | S DIE=3.9,DA=XMZ,DR="1.7////P" D ^DIE K DIE,DA,DR ;send priority
|
|---|
| 22 | S XMY(DUZ)=""
|
|---|
| 23 | S XMY(GRP)=""
|
|---|
| 24 | S XMTEXT="RMPFARR("
|
|---|
| 25 | S XMDUZ=DUZ
|
|---|
| 26 | D EN1^XMD ;SEND MSG
|
|---|
| 27 | S:$G(XMERR) RE=0 ;error occurred
|
|---|
| 28 | END ;
|
|---|
| 29 | I XMZ>0 D
|
|---|
| 30 | .I SUBJ="ROES Eligibility Request" D ;setup node after msg from asps to psas
|
|---|
| 31 | ..S DFN=$O(^DPT("SSN",SSN,0)) Q:'DFN
|
|---|
| 32 | ..S DIC="^RMPF(791814,",DIC(0)="FZ",X=DFN,DLAYGO=791814
|
|---|
| 33 | ..K DD,D0 D FILE^DICN Q:Y<1 S DIE=DIC,DA=+Y
|
|---|
| 34 | ..S DR=".02////"_DT_";.03////"_DUZ_";.04///"_$$FMADD^XLFDT(DT,60) D ^DIE ;60 DAYS FOR PSAS TO ACT
|
|---|
| 35 | ..S DR="1.01////"_SG_";1.02////"_XMZ_";2.02////2" D ^DIE K DIE,DA,DR
|
|---|
| 36 | D KILL^XM
|
|---|
| 37 | Q
|
|---|
