RMPR218P ;HDSO/DSK - RMPR*3.0*218 Post-Install Routine; Jan 06, 2025@14:30
;;3.0;PROSTHETICS;**218**;Feb 09, 1996;Build 12
;
; Reference to ^XUSEC in IA #10076
; Reference to BMES^XPDUTL in IA #10141
;
Q
;
EN ;
K ^XTMP("RMPR*3.0*218 POST INSTALL")
S ^XTMP("RMPR*3.0*218 POST INSTALL",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^RMPR*3.0*218 POST INSTALL"
N RMPRIEN,RMPRSTR,RMPRSEQ,RMPRSPACE,RMPRTXT
N DIE,DR,DA
S RMPRSEQ=12,RMPRIEN=0,$P(RMPRSPACE," ",50)=""
S DIE=669.9,DR="19///@;20///@;21///@"
F S RMPRIEN=$O(^RMPR(669.9,RMPRIEN)) Q:'RMPRIEN D
. S RMPRSTR=^RMPR(669.9,RMPRIEN,0)
. ;Save field values for backout logic.
. S ^XTMP("RMPR*3.0*218 POST INSTALL",.5,RMPRIEN)=$P(RMPRSTR,"^")_"^"_$P(RMPRSTR,"^",8,10)
. S DA=RMPRIEN
. D ^DIE
. S $P(RMPRSTR,"^")=$E($P(RMPRSTR,"^"),1,29)
. S RMPRTXT=$P(RMPRSTR,"^")_$E(RMPRSPACE,1,30-$L($P(RMPRSTR,"^")))_$P(RMPRSTR,"^",8)
. S RMPRTXT=RMPRTXT_$E(RMPRSPACE,1,12-$L($P(RMPRSTR,"^",8)))_$P(RMPRSTR,"^",9)
. S RMPRTXT=RMPRTXT_$E(RMPRSPACE,1,12-$L($P(RMPRSTR,"^",9)))_$P(RMPRSTR,"^",10)
. S RMPRSEQ=RMPRSEQ+1
. S ^XTMP("RMPR*3.0*218 POST INSTALL",RMPRSEQ)=RMPRTXT
D BMES^XPDUTL("RMPR*3.0*218 post-install routine complete.")
D MAIL
Q
;
MAIL ;
N RMPRIEN,RMPRMIN,RMPRMY,RMPRX,RMPRMSUB,RMPRMTEXT
S RMPRMIN("FROM")="RMPR*3.0*218 Post-Install"
S RMPRMY(DUZ)=""
S RMPRX=""
F S RMPRX=$O(^XUSEC("RMPRMANAGER",RMPRX)) Q:RMPRX="" D
. S RMPRMY(RMPRX)=""
S RMPRMSUB="RMPR*3.0*218 Post-Install"
S ^XTMP("RMPR*3.0*218 POST INSTALL",1)="RMPR*3.0*218 post-install routine has completed."
S ^XTMP("RMPR*3.0*218 POST INSTALL",2)=" "
S ^XTMP("RMPR*3.0*218 POST INSTALL",3)="Entries in the following fields have been deleted:"
S ^XTMP("RMPR*3.0*218 POST INSTALL",4)=" *SUSPENSE PURGE (#19)"
S ^XTMP("RMPR*3.0*218 POST INSTALL",5)=" *CLOSE-OUT PURCHASING PURGE (#20)"
S ^XTMP("RMPR*3.0*218 POST INSTALL",6)=" *CANCELLATION PURCHASING PURGE (#21)"
S ^XTMP("RMPR*3.0*218 POST INSTALL",7)=" "
S ^XTMP("RMPR*3.0*218 POST INSTALL",8)="for sites in the PROSTHETIC SITE PARAMETERS (#669.9) file."
S ^XTMP("RMPR*3.0*218 POST INSTALL",9)="The deleted field values are listed below."
S ^XTMP("RMPR*3.0*218 POST INSTALL",10)=" "
S ^XTMP("RMPR*3.0*218 POST INSTALL",11)="Site Field #19 Field #20 Field #21"
S ^XTMP("RMPR*3.0*218 POST INSTALL",12)="----------------------------- ----------- ----------- ---------"
I '$O(^XTMP("RMPR*3.0*218 POST INSTALL",.5,0)) D
. S ^XTMP("RMPR*3.0*218 POST INSTALL",11)=" None - No sites are defined in this environment."
. K ^XTMP("RMPR*3.0*218 POST INSTALL",12)
S RMPRMTEXT="^XTMP(""RMPR*3.0*218 POST INSTALL"")"
D SENDMSG^XMXAPI(DUZ,RMPRMSUB,RMPRMTEXT,.RMPRMY,.RMPRMIN,"","")
Q
;
BACKOUT ;
N DIR,DTOUT,DUOUT,Y
S DIR("A",1)="This command is the final step in backing out patch RMPR*3.0*218."
S DIR("A",2)="Make sure you have also installed the backup build as instructed"
S DIR("A",3)="in the patch description."
S DIR("A",4)=" "
S DIR("A",5)="After completion, a MailMan message will be sent to holders of"
S DIR("A",6)="of the RMPRMANAGER security key as well as yourself."
S DIR("A")="Press enter to continue or ^ to quit and exit",DIR(0)="E"
D ^DIR
I 'Y!($D(DTOUT))!($D(DUOUT)) D Q
. W !!,"Aborting backout process"
K ^XTMP("RMPR*3.0*218 BACKOUT")
S ^XTMP("RMPR*3.0*218 BACKOUT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^RMPR*3.0*218 BACKOUT"
N RMPRIEN,RMPRSTR,RMPRSEQ,RMPRSPACE,RMPRTXT
N DIE,DR,DA
S RMPRIEN=0,RMPRSEQ=12,$P(RMPRSPACE," ",50)="",DIE=669.9
F S RMPRIEN=$O(^RMPR(669.9,RMPRIEN)) Q:'RMPRIEN D
. ;Making sure site was not added after the RMPR*3.0*218 post install.
. Q:'$D(^XTMP("RMPR*3.0*218 POST INSTALL",.5,RMPRIEN))
. S RMPRSTR=^XTMP("RMPR*3.0*218 POST INSTALL",.5,RMPRIEN)
. S DR="19////"_$P(RMPRSTR,"^",2)_";20////"_$P(RMPRSTR,"^",3)_";21////"_$P(RMPRSTR,"^",4)
. S DA=RMPRIEN
. D ^DIE
. S ^XTMP("RMPR*3.0*218 BACKOUT",.5,RMPRIEN)=RMPRSTR
. S RMPRSEQ=RMPRSEQ+1
. S $P(RMPRSTR,"^")=$E($P(RMPRSTR,"^"),1,29)
. S RMPRTXT=$P(RMPRSTR,"^")_$E(RMPRSPACE,1,30-$L($P(RMPRSTR,"^")))_$P(RMPRSTR,"^",2)
. S RMPRTXT=RMPRTXT_$E(RMPRSPACE,1,12-$L($P(RMPRSTR,"^",2)))_$P(RMPRSTR,"^",3)
. S RMPRTXT=RMPRTXT_$E(RMPRSPACE,1,12-$L($P(RMPRSTR,"^",3)))_$P(RMPRSTR,"^",4)
. S RMPRSEQ=RMPRSEQ+1
. S ^XTMP("RMPR*3.0*218 BACKOUT",RMPRSEQ)=RMPRTXT
D BMAIL
W !,"Backout complete."
Q
;
BMAIL ;
N RMPRMIN,RMPRMY,RMPRX,RMPRMSUB,RMPRMTEXT
S RMPRMIN("FROM")="RMPR*3.0*218 Patch Backout"
S RMPRMY(DUZ)=""
S RMPRX=""
F S RMPRX=$O(^XUSEC("RMPRMANAGER",RMPRX)) Q:RMPRX="" D
. S RMPRMY(RMPRX)=""
S RMPRMSUB="RMPR*3.0*218 Patch Back out"
S ^XTMP("RMPR*3.0*218 BACKOUT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^RMPR*3.0*218 Back out"
S ^XTMP("RMPR*3.0*218 BACKOUT",1)="RMPR*3.0*218 backout has completed."
S ^XTMP("RMPR*3.0*218 BACKOUT",2)=" "
S ^XTMP("RMPR*3.0*218 BACKOUT",3)="Entries in the following fields have been re-populated:"
S ^XTMP("RMPR*3.0*218 BACKOUT",4)=" SUSPENSE PURGE (#19)"
S ^XTMP("RMPR*3.0*218 BACKOUT",5)=" CLOSE-OUT PURCHASING PURGE (#20)"
S ^XTMP("RMPR*3.0*218 BACKOUT",6)=" CANCELLATION PURCHASING PURGE (#21)"
S ^XTMP("RMPR*3.0*218 BACKOUT",7)=" "
S ^XTMP("RMPR*3.0*218 BACKOUT",8)="for sites in the PROSTHETIC SITE PARAMETERS (#669.9) file."
S ^XTMP("RMPR*3.0*218 BACKOUT",9)="The re-populated values are listed below."
S ^XTMP("RMPR*3.0*218 BACKOUT",10)=" "
S ^XTMP("RMPR*3.0*218 BACKOUT",11)="Site Field #19 Field #20 Field #21"
S ^XTMP("RMPR*3.0*218 BACKOUT",12)="----------------------------- ---------- ------------ ---------"
I '$O(^XTMP("RMPR*3.0*218 POST INSTALL",.5,0)) D
. S ^XTMP("RMPR*3.0*218 POST INSTALL",11)=" None - No sites were defined in this environment"
. S ^XTMP("RMPR*3.0*218 POST INSTALL",12)=" at the time when RMPR*3.0*218 was installed."
S RMPRMTEXT="^XTMP(""RMPR*3.0*218 BACKOUT"")"
D SENDMSG^XMXAPI(DUZ,RMPRMSUB,RMPRMTEXT,.RMPRMY,.RMPRMIN,"","")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR218P 6026 printed Jan 29, 2026@15:30:36 Page 2
RMPR218P ;HDSO/DSK - RMPR*3.0*218 Post-Install Routine; Jan 06, 2025@14:30
+1 ;;3.0;PROSTHETICS;**218**;Feb 09, 1996;Build 12
+2 ;
+3 ; Reference to ^XUSEC in IA #10076
+4 ; Reference to BMES^XPDUTL in IA #10141
+5 ;
+6 QUIT
+7 ;
EN ;
+1 KILL ^XTMP("RMPR*3.0*218 POST INSTALL")
+2 SET ^XTMP("RMPR*3.0*218 POST INSTALL",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^RMPR*3.0*218 POST INSTALL"
+3 NEW RMPRIEN,RMPRSTR,RMPRSEQ,RMPRSPACE,RMPRTXT
+4 NEW DIE,DR,DA
+5 SET RMPRSEQ=12
SET RMPRIEN=0
SET $PIECE(RMPRSPACE," ",50)=""
+6 SET DIE=669.9
SET DR="19///@;20///@;21///@"
+7 FOR
SET RMPRIEN=$ORDER(^RMPR(669.9,RMPRIEN))
if 'RMPRIEN
QUIT
Begin DoDot:1
+8 SET RMPRSTR=^RMPR(669.9,RMPRIEN,0)
+9 ;Save field values for backout logic.
+10 SET ^XTMP("RMPR*3.0*218 POST INSTALL",.5,RMPRIEN)=$PIECE(RMPRSTR,"^")_"^"_$PIECE(RMPRSTR,"^",8,10)
+11 SET DA=RMPRIEN
+12 DO ^DIE
+13 SET $PIECE(RMPRSTR,"^")=$EXTRACT($PIECE(RMPRSTR,"^"),1,29)
+14 SET RMPRTXT=$PIECE(RMPRSTR,"^")_$EXTRACT(RMPRSPACE,1,30-$LENGTH($PIECE(RMPRSTR,"^")))_$PIECE(RMPRSTR,"^",8)
+15 SET RMPRTXT=RMPRTXT_$EXTRACT(RMPRSPACE,1,12-$LENGTH($PIECE(RMPRSTR,"^",8)))_$PIECE(RMPRSTR,"^",9)
+16 SET RMPRTXT=RMPRTXT_$EXTRACT(RMPRSPACE,1,12-$LENGTH($PIECE(RMPRSTR,"^",9)))_$PIECE(RMPRSTR,"^",10)
+17 SET RMPRSEQ=RMPRSEQ+1
+18 SET ^XTMP("RMPR*3.0*218 POST INSTALL",RMPRSEQ)=RMPRTXT
End DoDot:1
+19 DO BMES^XPDUTL("RMPR*3.0*218 post-install routine complete.")
+20 DO MAIL
+21 QUIT
+22 ;
MAIL ;
+1 NEW RMPRIEN,RMPRMIN,RMPRMY,RMPRX,RMPRMSUB,RMPRMTEXT
+2 SET RMPRMIN("FROM")="RMPR*3.0*218 Post-Install"
+3 SET RMPRMY(DUZ)=""
+4 SET RMPRX=""
+5 FOR
SET RMPRX=$ORDER(^XUSEC("RMPRMANAGER",RMPRX))
if RMPRX=""
QUIT
Begin DoDot:1
+6 SET RMPRMY(RMPRX)=""
End DoDot:1
+7 SET RMPRMSUB="RMPR*3.0*218 Post-Install"
+8 SET ^XTMP("RMPR*3.0*218 POST INSTALL",1)="RMPR*3.0*218 post-install routine has completed."
+9 SET ^XTMP("RMPR*3.0*218 POST INSTALL",2)=" "
+10 SET ^XTMP("RMPR*3.0*218 POST INSTALL",3)="Entries in the following fields have been deleted:"
+11 SET ^XTMP("RMPR*3.0*218 POST INSTALL",4)=" *SUSPENSE PURGE (#19)"
+12 SET ^XTMP("RMPR*3.0*218 POST INSTALL",5)=" *CLOSE-OUT PURCHASING PURGE (#20)"
+13 SET ^XTMP("RMPR*3.0*218 POST INSTALL",6)=" *CANCELLATION PURCHASING PURGE (#21)"
+14 SET ^XTMP("RMPR*3.0*218 POST INSTALL",7)=" "
+15 SET ^XTMP("RMPR*3.0*218 POST INSTALL",8)="for sites in the PROSTHETIC SITE PARAMETERS (#669.9) file."
+16 SET ^XTMP("RMPR*3.0*218 POST INSTALL",9)="The deleted field values are listed below."
+17 SET ^XTMP("RMPR*3.0*218 POST INSTALL",10)=" "
+18 SET ^XTMP("RMPR*3.0*218 POST INSTALL",11)="Site Field #19 Field #20 Field #21"
+19 SET ^XTMP("RMPR*3.0*218 POST INSTALL",12)="----------------------------- ----------- ----------- ---------"
+20 IF '$ORDER(^XTMP("RMPR*3.0*218 POST INSTALL",.5,0))
Begin DoDot:1
+21 SET ^XTMP("RMPR*3.0*218 POST INSTALL",11)=" None - No sites are defined in this environment."
+22 KILL ^XTMP("RMPR*3.0*218 POST INSTALL",12)
End DoDot:1
+23 SET RMPRMTEXT="^XTMP(""RMPR*3.0*218 POST INSTALL"")"
+24 DO SENDMSG^XMXAPI(DUZ,RMPRMSUB,RMPRMTEXT,.RMPRMY,.RMPRMIN,"","")
+25 QUIT
+26 ;
BACKOUT ;
+1 NEW DIR,DTOUT,DUOUT,Y
+2 SET DIR("A",1)="This command is the final step in backing out patch RMPR*3.0*218."
+3 SET DIR("A",2)="Make sure you have also installed the backup build as instructed"
+4 SET DIR("A",3)="in the patch description."
+5 SET DIR("A",4)=" "
+6 SET DIR("A",5)="After completion, a MailMan message will be sent to holders of"
+7 SET DIR("A",6)="of the RMPRMANAGER security key as well as yourself."
+8 SET DIR("A")="Press enter to continue or ^ to quit and exit"
SET DIR(0)="E"
+9 DO ^DIR
+10 IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
Begin DoDot:1
+11 WRITE !!,"Aborting backout process"
End DoDot:1
QUIT
+12 KILL ^XTMP("RMPR*3.0*218 BACKOUT")
+13 SET ^XTMP("RMPR*3.0*218 BACKOUT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^RMPR*3.0*218 BACKOUT"
+14 NEW RMPRIEN,RMPRSTR,RMPRSEQ,RMPRSPACE,RMPRTXT
+15 NEW DIE,DR,DA
+16 SET RMPRIEN=0
SET RMPRSEQ=12
SET $PIECE(RMPRSPACE," ",50)=""
SET DIE=669.9
+17 FOR
SET RMPRIEN=$ORDER(^RMPR(669.9,RMPRIEN))
if 'RMPRIEN
QUIT
Begin DoDot:1
+18 ;Making sure site was not added after the RMPR*3.0*218 post install.
+19 if '$DATA(^XTMP("RMPR*3.0*218 POST INSTALL",.5,RMPRIEN))
QUIT
+20 SET RMPRSTR=^XTMP("RMPR*3.0*218 POST INSTALL",.5,RMPRIEN)
+21 SET DR="19////"_$PIECE(RMPRSTR,"^",2)_";20////"_$PIECE(RMPRSTR,"^",3)_";21////"_$PIECE(RMPRSTR,"^",4)
+22 SET DA=RMPRIEN
+23 DO ^DIE
+24 SET ^XTMP("RMPR*3.0*218 BACKOUT",.5,RMPRIEN)=RMPRSTR
+25 SET RMPRSEQ=RMPRSEQ+1
+26 SET $PIECE(RMPRSTR,"^")=$EXTRACT($PIECE(RMPRSTR,"^"),1,29)
+27 SET RMPRTXT=$PIECE(RMPRSTR,"^")_$EXTRACT(RMPRSPACE,1,30-$LENGTH($PIECE(RMPRSTR,"^")))_$PIECE(RMPRSTR,"^",2)
+28 SET RMPRTXT=RMPRTXT_$EXTRACT(RMPRSPACE,1,12-$LENGTH($PIECE(RMPRSTR,"^",2)))_$PIECE(RMPRSTR,"^",3)
+29 SET RMPRTXT=RMPRTXT_$EXTRACT(RMPRSPACE,1,12-$LENGTH($PIECE(RMPRSTR,"^",3)))_$PIECE(RMPRSTR,"^",4)
+30 SET RMPRSEQ=RMPRSEQ+1
+31 SET ^XTMP("RMPR*3.0*218 BACKOUT",RMPRSEQ)=RMPRTXT
End DoDot:1
+32 DO BMAIL
+33 WRITE !,"Backout complete."
+34 QUIT
+35 ;
BMAIL ;
+1 NEW RMPRMIN,RMPRMY,RMPRX,RMPRMSUB,RMPRMTEXT
+2 SET RMPRMIN("FROM")="RMPR*3.0*218 Patch Backout"
+3 SET RMPRMY(DUZ)=""
+4 SET RMPRX=""
+5 FOR
SET RMPRX=$ORDER(^XUSEC("RMPRMANAGER",RMPRX))
if RMPRX=""
QUIT
Begin DoDot:1
+6 SET RMPRMY(RMPRX)=""
End DoDot:1
+7 SET RMPRMSUB="RMPR*3.0*218 Patch Back out"
+8 SET ^XTMP("RMPR*3.0*218 BACKOUT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^RMPR*3.0*218 Back out"
+9 SET ^XTMP("RMPR*3.0*218 BACKOUT",1)="RMPR*3.0*218 backout has completed."
+10 SET ^XTMP("RMPR*3.0*218 BACKOUT",2)=" "
+11 SET ^XTMP("RMPR*3.0*218 BACKOUT",3)="Entries in the following fields have been re-populated:"
+12 SET ^XTMP("RMPR*3.0*218 BACKOUT",4)=" SUSPENSE PURGE (#19)"
+13 SET ^XTMP("RMPR*3.0*218 BACKOUT",5)=" CLOSE-OUT PURCHASING PURGE (#20)"
+14 SET ^XTMP("RMPR*3.0*218 BACKOUT",6)=" CANCELLATION PURCHASING PURGE (#21)"
+15 SET ^XTMP("RMPR*3.0*218 BACKOUT",7)=" "
+16 SET ^XTMP("RMPR*3.0*218 BACKOUT",8)="for sites in the PROSTHETIC SITE PARAMETERS (#669.9) file."
+17 SET ^XTMP("RMPR*3.0*218 BACKOUT",9)="The re-populated values are listed below."
+18 SET ^XTMP("RMPR*3.0*218 BACKOUT",10)=" "
+19 SET ^XTMP("RMPR*3.0*218 BACKOUT",11)="Site Field #19 Field #20 Field #21"
+20 SET ^XTMP("RMPR*3.0*218 BACKOUT",12)="----------------------------- ---------- ------------ ---------"
+21 IF '$ORDER(^XTMP("RMPR*3.0*218 POST INSTALL",.5,0))
Begin DoDot:1
+22 SET ^XTMP("RMPR*3.0*218 POST INSTALL",11)=" None - No sites were defined in this environment"
+23 SET ^XTMP("RMPR*3.0*218 POST INSTALL",12)=" at the time when RMPR*3.0*218 was installed."
End DoDot:1
+24 SET RMPRMTEXT="^XTMP(""RMPR*3.0*218 BACKOUT"")"
+25 DO SENDMSG^XMXAPI(DUZ,RMPRMSUB,RMPRMTEXT,.RMPRMY,.RMPRMIN,"","")
+26 QUIT
