RMPFRPC3 ;DDC/PJU - ROES3 ELIGIBILITY MESSAGES ;11/01/02
;;3.0;REMOTE ORDER ENTRY SYSTEM;;11/01/02
START(RE,DUZ,GRP,SUBJ,RMPFARR) ;ELIG MSGS;
;RE WILL RETURN 1 if OK, 0 if error and XMZ if mail msg sent
;DUZ OF USER
;MAIL GROUP RECEIVING
;SUBJECT LINE
;ARRAY OF TEXT LINES FOR MSG
N CT,XMZ,EL,AP,SSN,SG,DFN S RE=1,(AP,EL,SG,SSN,DFN)=""
SEND D KILL^XM
S CT=0 F S CT=$O(RMPFARR(CT)) Q:'CT D
.S:$P(RMPFARR(CT)," ",1)="Eligibility:" EL=$P(RMPFARR(CT),":",2),EL=$$TRIM^XLFSTR(EL)
.S:$P(RMPFARR(CT)," ",1)="SSN:" SSN=$P(RMPFARR(CT),":",2),SSN=$$TRIM^XLFSTR(SSN)
.S:$P(RMPFARR(CT),":",1)="Suggested Eligibility" SG=$P($G(RMPFARR(CT)),":",2),SG=$$TRIM^XLFSTR(SG)
.S:$P(RMPFARR(CT)," ",1)="Request:" AP=$P(RMPFARR(CT),":",2),AP=$$TRIM^XLFSTR(AP) ;approved/disapproved
S XMSUB=SUBJ
S XMDUZ=DUZ
D XMZ^XMA2
I XMZ<0 S RE=0 G END
S RE=XMZ
S DIE=3.9,DA=XMZ,DR="1.7////P" D ^DIE K DIE,DA,DR ;send priority
S XMY(DUZ)=""
S XMY(GRP)=""
S XMTEXT="RMPFARR("
S XMDUZ=DUZ
D EN1^XMD ;SEND MSG
S:$G(XMERR) RE=0 ;error occurred
END ;
I XMZ>0 D
.I SUBJ="ROES Eligibility Request" D ;setup node after msg from asps to psas
..S DFN=$O(^DPT("SSN",SSN,0)) Q:'DFN
..S DIC="^RMPF(791814,",DIC(0)="FZ",X=DFN,DLAYGO=791814
..K DD,D0 D FILE^DICN Q:Y<1 S DIE=DIC,DA=+Y
..S DR=".02////"_DT_";.03////"_DUZ_";.04///"_$$FMADD^XLFDT(DT,60) D ^DIE ;60 DAYS FOR PSAS TO ACT
..S DR="1.01////"_SG_";1.02////"_XMZ_";2.02////2" D ^DIE K DIE,DA,DR
D KILL^XM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFRPC3 1496 printed Mar 13, 2024@23:46:08 Page 2
RMPFRPC3 ;DDC/PJU - ROES3 ELIGIBILITY MESSAGES ;11/01/02
+1 ;;3.0;REMOTE ORDER ENTRY SYSTEM;;11/01/02
START(RE,DUZ,GRP,SUBJ,RMPFARR) ;ELIG MSGS;
+1 ;RE WILL RETURN 1 if OK, 0 if error and XMZ if mail msg sent
+2 ;DUZ OF USER
+3 ;MAIL GROUP RECEIVING
+4 ;SUBJECT LINE
+5 ;ARRAY OF TEXT LINES FOR MSG
+6 NEW CT,XMZ,EL,AP,SSN,SG,DFN
SET RE=1
SET (AP,EL,SG,SSN,DFN)=""
SEND DO KILL^XM
+1 SET CT=0
FOR
SET CT=$ORDER(RMPFARR(CT))
if 'CT
QUIT
Begin DoDot:1
+2 if $PIECE(RMPFARR(CT)," ",1)="Eligibility
SET EL=$PIECE(RMPFARR(CT),":",2)
SET EL=$$TRIM^XLFSTR(EL)
+3 if $PIECE(RMPFARR(CT)," ",1)="SSN
SET SSN=$PIECE(RMPFARR(CT),":",2)
SET SSN=$$TRIM^XLFSTR(SSN)
+4 if $PIECE(RMPFARR(CT),"
SET SG=$PIECE($GET(RMPFARR(CT)),":",2)
SET SG=$$TRIM^XLFSTR(SG)
+5 ;approved/disapproved
if $PIECE(RMPFARR(CT)," ",1)="Request
SET AP=$PIECE(RMPFARR(CT),":",2)
SET AP=$$TRIM^XLFSTR(AP)
End DoDot:1
+6 SET XMSUB=SUBJ
+7 SET XMDUZ=DUZ
+8 DO XMZ^XMA2
+9 IF XMZ<0
SET RE=0
GOTO END
+10 SET RE=XMZ
+11 ;send priority
SET DIE=3.9
SET DA=XMZ
SET DR="1.7////P"
DO ^DIE
KILL DIE,DA,DR
+12 SET XMY(DUZ)=""
+13 SET XMY(GRP)=""
+14 SET XMTEXT="RMPFARR("
+15 SET XMDUZ=DUZ
+16 ;SEND MSG
DO EN1^XMD
+17 ;error occurred
if $GET(XMERR)
SET RE=0
END ;
+1 IF XMZ>0
Begin DoDot:1
+2 ;setup node after msg from asps to psas
IF SUBJ="ROES Eligibility Request"
Begin DoDot:2
+3 SET DFN=$ORDER(^DPT("SSN",SSN,0))
if 'DFN
QUIT
+4 SET DIC="^RMPF(791814,"
SET DIC(0)="FZ"
SET X=DFN
SET DLAYGO=791814
+5 KILL DD,D0
DO FILE^DICN
if Y<1
QUIT
SET DIE=DIC
SET DA=+Y
+6 ;60 DAYS FOR PSAS TO ACT
SET DR=".02////"_DT_";.03////"_DUZ_";.04///"_$$FMADD^XLFDT(DT,60)
DO ^DIE
+7 SET DR="1.01////"_SG_";1.02////"_XMZ_";2.02////2"
DO ^DIE
KILL DIE,DA,DR
End DoDot:2
End DoDot:1
+8 DO KILL^XM
+9 QUIT