| 1 | RMPR129P ;VMP/RB - POST INIT FOR PACKAGE FILE (#9.4) UPDATES BY PROSTHETIC BUILDS ;08/22/06
|
|---|
| 2 | ;;3.0;Prosthetics;**129**;06/20/05;Build 2
|
|---|
| 3 | ;;
|
|---|
| 4 | ;Post install to remove erroneous Prosthetics merge nodes set
|
|---|
| 5 | ;into the Package file (#9.4) for merging capabilities. These
|
|---|
| 6 | ;nodes were set in by accident as Prosthetics builds being sent to sites
|
|---|
| 7 | ;did not have a null response under Install Questions, Edit PACKAGE File
|
|---|
| 8 | ;response Select Affects Record Merge. These bogus Prosthetics entries
|
|---|
| 9 | ;to the Package file will be located and deleted at the 20 node level.
|
|---|
| 10 | ;The package merge errors occur since the Prosthetics node ^DIC(9.4,D0,20,D1,0)
|
|---|
| 11 | ;has routine RMPRPFC in piece 3 for the merge to execute.
|
|---|
| 12 | SRCH1 N PIEN,MIEN
|
|---|
| 13 | S PIEN=0
|
|---|
| 14 | F S PIEN=$O(^DIC(9.4,PIEN)) Q:PIEN=""!(PIEN]"@") D
|
|---|
| 15 | . ;Check for Prosthetics merge entry
|
|---|
| 16 | . S PACKR=$G(^DIC(9.4,PIEN,0)) Q:PACKR=""!(PACKR]"@")
|
|---|
| 17 | . I PACKR["PROS"!(PACKR["Pros") D
|
|---|
| 18 | .. ;KILL PROS ENTRY 20 NODES IF PIECE 3 = 'RMPRPFC'
|
|---|
| 19 | .. S MIEN=0
|
|---|
| 20 | .. F S MIEN=$O(^DIC(9.4,PIEN,20,MIEN)) Q:MIEN="" D
|
|---|
| 21 | ... S MERGREC=$G(^DIC(9.4,PIEN,20,MIEN,0)) Q:MERGREC=""
|
|---|
| 22 | ... I $P(MERGREC,U,3)="RMPRPFC" D
|
|---|
| 23 | .... ;DELETE INVALID MERGE REC WITH ROUTINE NAME 'RMPRPFC'
|
|---|
| 24 | .... S DA(1)=PIEN,DIK="^DIC(9.4,"_PIEN_",20,",DA=MIEN D ^DIK K DA,DIK
|
|---|
| 25 | K MERGREC,PACKR
|
|---|
| 26 | SRCH2 ;clean VA(15.2)-XDR MERGE PROCESS FILE for same invalid process
|
|---|
| 27 | N PIEN,MIEN
|
|---|
| 28 | S PIEN=0
|
|---|
| 29 | F S PIEN=$O(^VA(15.2,PIEN)) Q:PIEN=""!(PIEN]"@") D
|
|---|
| 30 | . ;Check for Prosthetics invalid merge process entry
|
|---|
| 31 | . ;KILL PROS INVALID PROS ENTRY IF PIECE 9 = 'RMPRPFC'
|
|---|
| 32 | . S MIEN=0
|
|---|
| 33 | . F S MIEN=$O(^VA(15.2,PIEN,3,MIEN)) Q:MIEN=""!(MIEN]"@") D
|
|---|
| 34 | .. S PROCREC=$G(^VA(15.2,PIEN,3,MIEN,0)) Q:PROCREC=""
|
|---|
| 35 | .. I $P(PROCREC,U,9)="RMPRPFC" D
|
|---|
| 36 | ... ;DELETE INVALID MERGE REC WITH ROUTINE NAME 'RMPRPFC'
|
|---|
| 37 | ... S DA(1)=PIEN,DIK="^VA(15.2,"_PIEN_",3,",DA=MIEN D ^DIK K DA,DIK
|
|---|
| 38 | K MERGREC,PACKR,PROCREC
|
|---|
| 39 | Q
|
|---|
