RMPR129P ;VMP/RB - POST INIT FOR PACKAGE FILE (#9.4) UPDATES BY PROSTHETIC BUILDS ;08/22/06
;;3.0;Prosthetics;**129**;06/20/05;Build 2
;;
;Post install to remove erroneous Prosthetics merge nodes set
;into the Package file (#9.4) for merging capabilities. These
;nodes were set in by accident as Prosthetics builds being sent to sites
;did not have a null response under Install Questions, Edit PACKAGE File
;response Select Affects Record Merge. These bogus Prosthetics entries
;to the Package file will be located and deleted at the 20 node level.
;The package merge errors occur since the Prosthetics node ^DIC(9.4,D0,20,D1,0)
;has routine RMPRPFC in piece 3 for the merge to execute.
SRCH1 N PIEN,MIEN
S PIEN=0
F S PIEN=$O(^DIC(9.4,PIEN)) Q:PIEN=""!(PIEN]"@") D
. ;Check for Prosthetics merge entry
. S PACKR=$G(^DIC(9.4,PIEN,0)) Q:PACKR=""!(PACKR]"@")
. I PACKR["PROS"!(PACKR["Pros") D
.. ;KILL PROS ENTRY 20 NODES IF PIECE 3 = 'RMPRPFC'
.. S MIEN=0
.. F S MIEN=$O(^DIC(9.4,PIEN,20,MIEN)) Q:MIEN="" D
... S MERGREC=$G(^DIC(9.4,PIEN,20,MIEN,0)) Q:MERGREC=""
... I $P(MERGREC,U,3)="RMPRPFC" D
.... ;DELETE INVALID MERGE REC WITH ROUTINE NAME 'RMPRPFC'
.... S DA(1)=PIEN,DIK="^DIC(9.4,"_PIEN_",20,",DA=MIEN D ^DIK K DA,DIK
K MERGREC,PACKR
SRCH2 ;clean VA(15.2)-XDR MERGE PROCESS FILE for same invalid process
N PIEN,MIEN
S PIEN=0
F S PIEN=$O(^VA(15.2,PIEN)) Q:PIEN=""!(PIEN]"@") D
. ;Check for Prosthetics invalid merge process entry
. ;KILL PROS INVALID PROS ENTRY IF PIECE 9 = 'RMPRPFC'
. S MIEN=0
. F S MIEN=$O(^VA(15.2,PIEN,3,MIEN)) Q:MIEN=""!(MIEN]"@") D
.. S PROCREC=$G(^VA(15.2,PIEN,3,MIEN,0)) Q:PROCREC=""
.. I $P(PROCREC,U,9)="RMPRPFC" D
... ;DELETE INVALID MERGE REC WITH ROUTINE NAME 'RMPRPFC'
... S DA(1)=PIEN,DIK="^VA(15.2,"_PIEN_",3,",DA=MIEN D ^DIK K DA,DIK
K MERGREC,PACKR,PROCREC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR129P 1886 printed Nov 22, 2024@17:41:47 Page 2
RMPR129P ;VMP/RB - POST INIT FOR PACKAGE FILE (#9.4) UPDATES BY PROSTHETIC BUILDS ;08/22/06
+1 ;;3.0;Prosthetics;**129**;06/20/05;Build 2
+2 ;;
+3 ;Post install to remove erroneous Prosthetics merge nodes set
+4 ;into the Package file (#9.4) for merging capabilities. These
+5 ;nodes were set in by accident as Prosthetics builds being sent to sites
+6 ;did not have a null response under Install Questions, Edit PACKAGE File
+7 ;response Select Affects Record Merge. These bogus Prosthetics entries
+8 ;to the Package file will be located and deleted at the 20 node level.
+9 ;The package merge errors occur since the Prosthetics node ^DIC(9.4,D0,20,D1,0)
+10 ;has routine RMPRPFC in piece 3 for the merge to execute.
SRCH1 NEW PIEN,MIEN
+1 SET PIEN=0
+2 FOR
SET PIEN=$ORDER(^DIC(9.4,PIEN))
if PIEN=""!(PIEN]"@")
QUIT
Begin DoDot:1
+3 ;Check for Prosthetics merge entry
+4 SET PACKR=$GET(^DIC(9.4,PIEN,0))
if PACKR=""!(PACKR]"@")
QUIT
+5 IF PACKR["PROS"!(PACKR["Pros")
Begin DoDot:2
+6 ;KILL PROS ENTRY 20 NODES IF PIECE 3 = 'RMPRPFC'
+7 SET MIEN=0
+8 FOR
SET MIEN=$ORDER(^DIC(9.4,PIEN,20,MIEN))
if MIEN=""
QUIT
Begin DoDot:3
+9 SET MERGREC=$GET(^DIC(9.4,PIEN,20,MIEN,0))
if MERGREC=""
QUIT
+10 IF $PIECE(MERGREC,U,3)="RMPRPFC"
Begin DoDot:4
+11 ;DELETE INVALID MERGE REC WITH ROUTINE NAME 'RMPRPFC'
+12 SET DA(1)=PIEN
SET DIK="^DIC(9.4,"_PIEN_",20,"
SET DA=MIEN
DO ^DIK
KILL DA,DIK
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 KILL MERGREC,PACKR
SRCH2 ;clean VA(15.2)-XDR MERGE PROCESS FILE for same invalid process
+1 NEW PIEN,MIEN
+2 SET PIEN=0
+3 FOR
SET PIEN=$ORDER(^VA(15.2,PIEN))
if PIEN=""!(PIEN]"@")
QUIT
Begin DoDot:1
+4 ;Check for Prosthetics invalid merge process entry
+5 ;KILL PROS INVALID PROS ENTRY IF PIECE 9 = 'RMPRPFC'
+6 SET MIEN=0
+7 FOR
SET MIEN=$ORDER(^VA(15.2,PIEN,3,MIEN))
if MIEN=""!(MIEN]"@")
QUIT
Begin DoDot:2
+8 SET PROCREC=$GET(^VA(15.2,PIEN,3,MIEN,0))
if PROCREC=""
QUIT
+9 IF $PIECE(PROCREC,U,9)="RMPRPFC"
Begin DoDot:3
+10 ;DELETE INVALID MERGE REC WITH ROUTINE NAME 'RMPRPFC'
+11 SET DA(1)=PIEN
SET DIK="^VA(15.2,"_PIEN_",3,"
SET DA=MIEN
DO ^DIK
KILL DA,DIK
End DoDot:3
End DoDot:2
End DoDot:1
+12 KILL MERGREC,PACKR,PROCREC
+13 QUIT
