- 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 Jan 18, 2025@03:32:47 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