RMPR112P ;VMP/RB - POST INIT FOR PACKAGE FILE (#9.4) UPDATES BY PROSTHETIC BUILDS ;06/17/05
;;3.0;Prosthetics;**112**;06/20/05
;;
;** Cameron Schlehuber created IA 4691 for a single use, private IA with Kernel (
; the custodian of the Package file)
;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 no routine in piece 3 for the merge to execute.
SRCH N PIEN,MIEN
S PIEN=0
F S PIEN=$O(^DIC(9.4,PIEN)) Q:PIEN=""!(PIEN>9999999) D
. ;Check for Prosthetics merge entry
. S PACKR=$G(^DIC(9.4,PIEN,0)) Q:PACKR=""!(PACKR>99999)
. I PACKR["PROS"!(PACKR["Pros") D
.. ;KILL PROS ENTRY 20 NODES IF PIECE 3 EMPTY
.. 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)="" D
.... ;DELETE INVALID MERGE REC WITH NO ROUTINE NAME
.... S DA(1)=PIEN,DIK="^DIC(9.4,"_PIEN_",20,",DA=MIEN D ^DIK K DA,DIK
K MERGREC,PACKR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR112P 1396 printed Dec 13, 2024@02:31:37 Page 2
RMPR112P ;VMP/RB - POST INIT FOR PACKAGE FILE (#9.4) UPDATES BY PROSTHETIC BUILDS ;06/17/05
+1 ;;3.0;Prosthetics;**112**;06/20/05
+2 ;;
+3 ;** Cameron Schlehuber created IA 4691 for a single use, private IA with Kernel (
+4 ; the custodian of the Package file)
+5 ;Post install to remove erroneous Prosthetics merge nodes set
+6 ;into the Package file (#9.4) for merging capabilities. These
+7 ;nodes were set in by accident as Prosthetics builds being sent to sites
+8 ;did not have a null response under Install Questions, Edit PACKAGE File
+9 ;response Select Affects Record Merge. These bogus Prosthetics entries
+10 ;to the Package file will be located and deleted at the 20 node level.
+11 ;The package merge errors occur since the Prosthetics node ^DIC(9.4,D0,20,D1,0)
+12 ;has no routine in piece 3 for the merge to execute.
SRCH NEW PIEN,MIEN
+1 SET PIEN=0
+2 FOR
SET PIEN=$ORDER(^DIC(9.4,PIEN))
if PIEN=""!(PIEN>9999999)
QUIT
Begin DoDot:1
+3 ;Check for Prosthetics merge entry
+4 SET PACKR=$GET(^DIC(9.4,PIEN,0))
if PACKR=""!(PACKR>99999)
QUIT
+5 IF PACKR["PROS"!(PACKR["Pros")
Begin DoDot:2
+6 ;KILL PROS ENTRY 20 NODES IF PIECE 3 EMPTY
+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)=""
Begin DoDot:4
+11 ;DELETE INVALID MERGE REC WITH NO ROUTINE NAME
+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
+14 QUIT
