RMPR213P ;HDSO/JSG - RMPR*3.0*213 Post-install routine; Mar 2, 2023@16:00
;;3.0;PROSTHETICS;**213**; 30 Oct 98;Build 12
;
;;Reference to $$ICDDX^ICDEX supported by ICR #5747
;;Reference to ^GMR(123,30.1) supported by ICR# 3067
;
Q
;
EN ;
;This post-install routine for RMPR*3.0*213 will:
;
;1. Scan for any records with "-1" in the ICD field (#1.6) of
; the PROSTHETIC SUSPENSE file (#668).
;
;2. When a record with "-1" is found, the PROVISIONAL DIAGNOSIS
; field (#1.5) is retrieved and the ICD10 code is extracted.
;
;3. Then retrieves the CONSULT pointer (#20)
;
;4. Using the CONSULT pointer, the PROVISIONAL DIAGNOSIS CODE (#30.2)
; is retrieved from the REQUEST CONSULTATION FILE (#123)
;
;5. The extracted code is used to call $$ICDDX^ICDEX to return
; the correct ICD10 pointer (IEN) for the code.
;
;6. The IEN is then inserted into the ICD field (#1.6).
;
;7. The unmodified record is stored in ^XTMP for potential
; recovery by executing BACKOUT^RMPR213P in programmer mode.
;
;8. This routine is not deleted after install since it is tasked.
; A future patch will delete the routine.
;
D BMES^XPDUTL($$LJ^XLFSTR("RMPR*3.0*213 Post-Install Routine will scan the PROSTHETIC SUSPENSE",80))
D BMES^XPDUTL($$LJ^XLFSTR("file for corrupt ICD fields and correct them.",80))
D BMES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
N RMPRDUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
S ZTRTN="START^RMPR213P"
S ZTDESC="RMPR*3.0*213 Post-Install Routine"
S ZTIO="",ZTDTH=$H
S RMPRDUZ=DUZ
S ZTSAVE("RMPRDUZ")=""
D ^%ZTLOAD
D BMES^XPDUTL($$LJ^XLFSTR("RMPR*3.0*213 Post-Install Routine has been tasked.",80))
D BMES^XPDUTL($$LJ^XLFSTR("Task Number: "_$G(ZTSK),80))
D BMES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
Q
;
START ;
;
S ^XTMP("RMPR*3.0*213 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*213 POST INSTALL"
;
N RMMAILSQ,RMPRNF,RMPRNC
S RMMAILSQ=0,(RMPRNF,RMPRNC)=0
D ICD,RMPR,MAIL
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
ICD ;
S ^XTMP("RMPR*3.0*213 POST INSTALL",1)=" "
S ^XTMP("RMPR*3.0*213 POST INSTALL",2)="The incorrect ICD entries in the PROSTHETIC SUSPENSE file (#668)"
S ^XTMP("RMPR*3.0*213 POST INSTALL",3)="have been corrected to contain an ICD10 IEN rather than ""-1""."
S ^XTMP("RMPR*3.0*213 POST INSTALL",4)=" "
Q
;
RMPR ;Correct records in the PROSTHETIC SUSPENSE file (#668).
N RMNX,RMICD,RMICDP,RMSTR,RM8ORIG,RM0ORIG,RMCON,RMPRDRXW
S RMNX=0
F S RMNX=$O(^RMPR(668,RMNX)) Q:RMNX<1 D ;QUIT IF:
. Q:'$D(^RMPR(668,RMNX,8)) S RM8ORIG=^(8) ;no 8 node
. Q:$P(RM8ORIG,"^",3)'="-1" ;3rd piece not -1
. S RMPRNF=RMPRNF+1
. Q:'$D(^RMPR(668,RMNX,0)) S RM0ORIG=^(0) ;no 0 node
. S RMCON=$P(RM0ORIG,"^",15) Q:RMCON="" ;no CONSULT
. S RMPRDRXW=$P(RM0ORIG,U,16) S:RMPRDRXW'>0 RMPRDRXW=DT ;date Rx written
. Q:'$$FIND1^DIC(123,,"A",RMCON) ;no CONSULT record
. S RMICD=$$GET1^DIQ(123,RMCON,30.1),RMICD=$P(RMICD,U)
. Q:RMICD="" ;no consult DIAGNOSIS record
. S RMICDP=$P($$ICDDX^ICDEX(RMICD,RMPRDRXW),"^") ;get the IEN for the correct code
. Q:RMICDP<0 ;invalid code
. S ^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMNX,8)=RM8ORIG ;preserve the old node value
. S $P(RM8ORIG,"^",3)=RMICDP,RMPRNC=RMPRNC+1
. S ^RMPR(668,RMNX,8)=RM8ORIG
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+5)="RMPR*3.0*213 Post Install Routine Summary Report"
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+6)="Number of records found needing correction: "_RMPRNF
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+7)=" Number of records corrected: "_RMPRNC
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+8)=" "
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+9)="******************************************************************"
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+10)="* The original records with the appropriate subscripts are *"
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+11)="* saved for 90 days at ^XTMP(""RMPR*3.0*213 POST INSTALL"",0). *"
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+12)="******************************************************************"
S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+13)=" "
I RMPRNC=0 S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+14)="No entries were found which needed correction."
Q
;
MAIL ;send MailMan message to installer and users with the RMPRMANAGER key.
N RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN,RMPRDUZ
I '$D(RMPRDUZ) S RMPRDUZ=DUZ
S RMPRTEXT="^XTMP(""RMPR*3.0*213 POST INSTALL"")"
S RMPRREC=""
F S RMPRREC=$O(^XUSEC("RMPRMANAGER",RMPRREC)) Q:RMPRREC="" S RMPRMY(RMPRREC)=""
S RMPRMY(RMPRDUZ)=""
S RMPRSUB="RMPR*3.0*213 Post-Install Summary Information"
S RMPRMIN("FROM")="RMPR*3.0*213 Post-Install"
D SENDMSG^XMXAPI(RMPRDUZ,RMPRSUB,RMPRTEXT,.RMPRMY,.RMPRMIN,"","")
Q
;
;
BACKOUT ;This section is invoked from the programmer's prompt if patch back out is required.
N DIR,Y
S DIR("A",1)="This action will back out the file modifications that were performed"
S DIR("A",2)="after the install of RMPR*3.0*213."
S DIR("A")="Are you sure you wish to proceed",DIR("B")="NO",DIR(0)="Y"
D ^DIR
Q:Y<1
;
S ^XTMP("RMPR*3.0*213 BACK OUT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*213 BACK OUT"
S ^XTMP("RMPR*3.0*213 BACK OUT",1)=" "
S ^XTMP("RMPR*3.0*213 BACK OUT",2)="Patch RMPR*3.0*213 was backed out by "_$$GET1^DIQ(200,DUZ,.01)_"."
S ^XTMP("RMPR*3.0*213 BACK OUT",3)=" "
;
N RMMAILSQ,RMPRZ,RMPRDUZ
S RMMAILSQ=3,RMPRDUZ=DUZ
W !!,"Please wait until the back out completes."
W !,"Working."
D ICDBACK,MAILBACK
Q
;
ICDBACK ;
N RMPRX,RMPRSTR,RMPRZ,RMPRDUZ
S RMPRZ=0,RMPRSTR="",(RMPRNF,RMPRNC)=0
F S RMPRZ=$O(^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ)) Q:RMPRZ="" S RMPRX=0 D
. F S RMPRX=$O(^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ,RMPRX)) Q:RMPRX="" D
.. S ^XTMP("RMPR*3.0*213 BACK OUT",0,668,RMPRZ,RMPRX)=^RMPR(668,RMPRZ,RMPRX)
.. S ^RMPR(668,RMPRZ,RMPRX)=^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ,RMPRX)
.. S RMPRNF=RMPRNF+1,RMPRNC=RMPRNC+1
;
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+1)="RMPR*3.0*213 Rollback Summary Report"
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+2)="Number of records found to rollback: "_RMPRNF
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+3)=" Number of records backed out: "_RMPRNC
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+4)=" "
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+5)="***************************************************************"
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+6)="* The corrected records with the appropriate subscripts are *"
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+7)="* saved for 90 days at ^XTMP(""RMPR*3.0*213 BACK OUT"",0). *"
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+8)="***************************************************************"
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+9)=" "
Q
;
MAILBACK ;
N RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN,RMPRMZ,DIR
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+10)="The text of this message will be stored in the global"
S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+11)="^XTMP(""RMPR*3.0*213 BACK OUT"" for 90 days."
S RMPRTEXT="^XTMP(""RMPR*3.0*213 BACK OUT"")"
S RMPRREC=""
F S RMPRREC=$O(^XUSEC("RMPRMANAGER",RMPRREC)) Q:RMPRREC="" S RMPRMY(RMPRREC)=""
S RMPRMY(RMPRDUZ)=""
S RMPRSUB="RMPR*3.0*213 Back Out Information"
S RMPRMIN("FROM")="RMPR*3.0*213 BACK OUT"
D SENDMSG^XMXAPI(RMPRDUZ,RMPRSUB,RMPRTEXT,.RMPRMY,.RMPRMIN,.RMPRMZ,"")
S DIR("A",1)="MailMan message #"_RMPRMZ_" has been sent to you as well as"
S DIR("A",2)="holders of the RMPRMANAGER security key."
S DIR("A")="Press any key to continue"
S DIR(0)="E" D ^DIR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR213P 7975 printed Sep 23, 2025@20:08:03 Page 2
RMPR213P ;HDSO/JSG - RMPR*3.0*213 Post-install routine; Mar 2, 2023@16:00
+1 ;;3.0;PROSTHETICS;**213**; 30 Oct 98;Build 12
+2 ;
+3 ;;Reference to $$ICDDX^ICDEX supported by ICR #5747
+4 ;;Reference to ^GMR(123,30.1) supported by ICR# 3067
+5 ;
+6 QUIT
+7 ;
EN ;
+1 ;This post-install routine for RMPR*3.0*213 will:
+2 ;
+3 ;1. Scan for any records with "-1" in the ICD field (#1.6) of
+4 ; the PROSTHETIC SUSPENSE file (#668).
+5 ;
+6 ;2. When a record with "-1" is found, the PROVISIONAL DIAGNOSIS
+7 ; field (#1.5) is retrieved and the ICD10 code is extracted.
+8 ;
+9 ;3. Then retrieves the CONSULT pointer (#20)
+10 ;
+11 ;4. Using the CONSULT pointer, the PROVISIONAL DIAGNOSIS CODE (#30.2)
+12 ; is retrieved from the REQUEST CONSULTATION FILE (#123)
+13 ;
+14 ;5. The extracted code is used to call $$ICDDX^ICDEX to return
+15 ; the correct ICD10 pointer (IEN) for the code.
+16 ;
+17 ;6. The IEN is then inserted into the ICD field (#1.6).
+18 ;
+19 ;7. The unmodified record is stored in ^XTMP for potential
+20 ; recovery by executing BACKOUT^RMPR213P in programmer mode.
+21 ;
+22 ;8. This routine is not deleted after install since it is tasked.
+23 ; A future patch will delete the routine.
+24 ;
+25 DO BMES^XPDUTL($$LJ^XLFSTR("RMPR*3.0*213 Post-Install Routine will scan the PROSTHETIC SUSPENSE",80))
+26 DO BMES^XPDUTL($$LJ^XLFSTR("file for corrupt ICD fields and correct them.",80))
+27 DO BMES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
+28 NEW RMPRDUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
+29 SET ZTRTN="START^RMPR213P"
+30 SET ZTDESC="RMPR*3.0*213 Post-Install Routine"
+31 SET ZTIO=""
SET ZTDTH=$HOROLOG
+32 SET RMPRDUZ=DUZ
+33 SET ZTSAVE("RMPRDUZ")=""
+34 DO ^%ZTLOAD
+35 DO BMES^XPDUTL($$LJ^XLFSTR("RMPR*3.0*213 Post-Install Routine has been tasked.",80))
+36 DO BMES^XPDUTL($$LJ^XLFSTR("Task Number: "_$GET(ZTSK),80))
+37 DO BMES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
+38 QUIT
+39 ;
START ;
+1 ;
+2 SET ^XTMP("RMPR*3.0*213 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*213 POST INSTALL"
+3 ;
+4 NEW RMMAILSQ,RMPRNF,RMPRNC
+5 SET RMMAILSQ=0
SET (RMPRNF,RMPRNC)=0
+6 DO ICD
DO RMPR
DO MAIL
+7 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
+9 ;
ICD ;
+1 SET ^XTMP("RMPR*3.0*213 POST INSTALL",1)=" "
+2 SET ^XTMP("RMPR*3.0*213 POST INSTALL",2)="The incorrect ICD entries in the PROSTHETIC SUSPENSE file (#668)"
+3 SET ^XTMP("RMPR*3.0*213 POST INSTALL",3)="have been corrected to contain an ICD10 IEN rather than ""-1""."
+4 SET ^XTMP("RMPR*3.0*213 POST INSTALL",4)=" "
+5 QUIT
+6 ;
RMPR ;Correct records in the PROSTHETIC SUSPENSE file (#668).
+1 NEW RMNX,RMICD,RMICDP,RMSTR,RM8ORIG,RM0ORIG,RMCON,RMPRDRXW
+2 SET RMNX=0
+3 ;QUIT IF:
FOR
SET RMNX=$ORDER(^RMPR(668,RMNX))
if RMNX<1
QUIT
Begin DoDot:1
+4 ;no 8 node
if '$DATA(^RMPR(668,RMNX,8))
QUIT
SET RM8ORIG=^(8)
+5 ;3rd piece not -1
if $PIECE(RM8ORIG,"^",3)'="-1"
QUIT
+6 SET RMPRNF=RMPRNF+1
+7 ;no 0 node
if '$DATA(^RMPR(668,RMNX,0))
QUIT
SET RM0ORIG=^(0)
+8 ;no CONSULT
SET RMCON=$PIECE(RM0ORIG,"^",15)
if RMCON=""
QUIT
+9 ;date Rx written
SET RMPRDRXW=$PIECE(RM0ORIG,U,16)
if RMPRDRXW'>0
SET RMPRDRXW=DT
+10 ;no CONSULT record
if '$$FIND1^DIC(123,,"A",RMCON)
QUIT
+11 SET RMICD=$$GET1^DIQ(123,RMCON,30.1)
SET RMICD=$PIECE(RMICD,U)
+12 ;no consult DIAGNOSIS record
if RMICD=""
QUIT
+13 ;get the IEN for the correct code
SET RMICDP=$PIECE($$ICDDX^ICDEX(RMICD,RMPRDRXW),"^")
+14 ;invalid code
if RMICDP<0
QUIT
+15 ;preserve the old node value
SET ^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMNX,8)=RM8ORIG
+16 SET $PIECE(RM8ORIG,"^",3)=RMICDP
SET RMPRNC=RMPRNC+1
+17 SET ^RMPR(668,RMNX,8)=RM8ORIG
End DoDot:1
+18 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+5)="RMPR*3.0*213 Post Install Routine Summary Report"
+19 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+6)="Number of records found needing correction: "_RMPRNF
+20 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+7)=" Number of records corrected: "_RMPRNC
+21 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+8)=" "
+22 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+9)="******************************************************************"
+23 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+10)="* The original records with the appropriate subscripts are *"
+24 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+11)="* saved for 90 days at ^XTMP(""RMPR*3.0*213 POST INSTALL"",0). *"
+25 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+12)="******************************************************************"
+26 SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+13)=" "
+27 IF RMPRNC=0
SET ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+14)="No entries were found which needed correction."
+28 QUIT
+29 ;
MAIL ;send MailMan message to installer and users with the RMPRMANAGER key.
+1 NEW RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN,RMPRDUZ
+2 IF '$DATA(RMPRDUZ)
SET RMPRDUZ=DUZ
+3 SET RMPRTEXT="^XTMP(""RMPR*3.0*213 POST INSTALL"")"
+4 SET RMPRREC=""
+5 FOR
SET RMPRREC=$ORDER(^XUSEC("RMPRMANAGER",RMPRREC))
if RMPRREC=""
QUIT
SET RMPRMY(RMPRREC)=""
+6 SET RMPRMY(RMPRDUZ)=""
+7 SET RMPRSUB="RMPR*3.0*213 Post-Install Summary Information"
+8 SET RMPRMIN("FROM")="RMPR*3.0*213 Post-Install"
+9 DO SENDMSG^XMXAPI(RMPRDUZ,RMPRSUB,RMPRTEXT,.RMPRMY,.RMPRMIN,"","")
+10 QUIT
+11 ;
+12 ;
BACKOUT ;This section is invoked from the programmer's prompt if patch back out is required.
+1 NEW DIR,Y
+2 SET DIR("A",1)="This action will back out the file modifications that were performed"
+3 SET DIR("A",2)="after the install of RMPR*3.0*213."
+4 SET DIR("A")="Are you sure you wish to proceed"
SET DIR("B")="NO"
SET DIR(0)="Y"
+5 DO ^DIR
+6 if Y<1
QUIT
+7 ;
+8 SET ^XTMP("RMPR*3.0*213 BACK OUT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*213 BACK OUT"
+9 SET ^XTMP("RMPR*3.0*213 BACK OUT",1)=" "
+10 SET ^XTMP("RMPR*3.0*213 BACK OUT",2)="Patch RMPR*3.0*213 was backed out by "_$$GET1^DIQ(200,DUZ,.01)_"."
+11 SET ^XTMP("RMPR*3.0*213 BACK OUT",3)=" "
+12 ;
+13 NEW RMMAILSQ,RMPRZ,RMPRDUZ
+14 SET RMMAILSQ=3
SET RMPRDUZ=DUZ
+15 WRITE !!,"Please wait until the back out completes."
+16 WRITE !,"Working."
+17 DO ICDBACK
DO MAILBACK
+18 QUIT
+19 ;
ICDBACK ;
+1 NEW RMPRX,RMPRSTR,RMPRZ,RMPRDUZ
+2 SET RMPRZ=0
SET RMPRSTR=""
SET (RMPRNF,RMPRNC)=0
+3 FOR
SET RMPRZ=$ORDER(^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ))
if RMPRZ=""
QUIT
SET RMPRX=0
Begin DoDot:1
+4 FOR
SET RMPRX=$ORDER(^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ,RMPRX))
if RMPRX=""
QUIT
Begin DoDot:2
+5 SET ^XTMP("RMPR*3.0*213 BACK OUT",0,668,RMPRZ,RMPRX)=^RMPR(668,RMPRZ,RMPRX)
+6 SET ^RMPR(668,RMPRZ,RMPRX)=^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ,RMPRX)
+7 SET RMPRNF=RMPRNF+1
SET RMPRNC=RMPRNC+1
End DoDot:2
End DoDot:1
+8 ;
+9 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+1)="RMPR*3.0*213 Rollback Summary Report"
+10 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+2)="Number of records found to rollback: "_RMPRNF
+11 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+3)=" Number of records backed out: "_RMPRNC
+12 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+4)=" "
+13 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+5)="***************************************************************"
+14 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+6)="* The corrected records with the appropriate subscripts are *"
+15 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+7)="* saved for 90 days at ^XTMP(""RMPR*3.0*213 BACK OUT"",0). *"
+16 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+8)="***************************************************************"
+17 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+9)=" "
+18 QUIT
+19 ;
MAILBACK ;
+1 NEW RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN,RMPRMZ,DIR
+2 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+10)="The text of this message will be stored in the global"
+3 SET ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+11)="^XTMP(""RMPR*3.0*213 BACK OUT"" for 90 days."
+4 SET RMPRTEXT="^XTMP(""RMPR*3.0*213 BACK OUT"")"
+5 SET RMPRREC=""
+6 FOR
SET RMPRREC=$ORDER(^XUSEC("RMPRMANAGER",RMPRREC))
if RMPRREC=""
QUIT
SET RMPRMY(RMPRREC)=""
+7 SET RMPRMY(RMPRDUZ)=""
+8 SET RMPRSUB="RMPR*3.0*213 Back Out Information"
+9 SET RMPRMIN("FROM")="RMPR*3.0*213 BACK OUT"
+10 DO SENDMSG^XMXAPI(RMPRDUZ,RMPRSUB,RMPRTEXT,.RMPRMY,.RMPRMIN,.RMPRMZ,"")
+11 SET DIR("A",1)="MailMan message #"_RMPRMZ_" has been sent to you as well as"
+12 SET DIR("A",2)="holders of the RMPRMANAGER security key."
+13 SET DIR("A")="Press any key to continue"
+14 SET DIR(0)="E"
DO ^DIR
+15 QUIT
+16 ;
