source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFRPC3.m@ 1806

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1RMPFRPC3 ;DDC/PJU - ROES3 ELIGIBILITY MESSAGES ;11/01/02
2 ;;3.0;REMOTE ORDER ENTRY SYSTEM;;11/01/02
3START(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)=""
10SEND 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
28END ;
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
Note: See TracBrowser for help on using the repository browser.