| [613] | 1 | ONCOPST4 ;HIRMFO/RTK-ROUTINE TO CLEAN UP FILE 165 ;2/21/96
|
|---|
| 2 | ;;2.11;ONCOLOGY;**1**;Feb 21, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; Routine to loop thru ONCOLOGY CONTACT file (#165) and clean up
|
|---|
| 5 | ; any duplicate entries.
|
|---|
| 6 | ;
|
|---|
| 7 | W !!,"Cleaning up duplicate entries in ONCOLOGY CONTACT (#165) file..."
|
|---|
| 8 | K ^TMP($J,"CONTACT")
|
|---|
| 9 | F XENTRY=0:0 S XENTRY=$O(^ONCO(165,XENTRY)) Q:XENTRY'>"" D
|
|---|
| 10 | .S COMMENT=$P($G(^ONCO(165,XENTRY,0)),"^",4)
|
|---|
| 11 | .Q:COMMENT=""!(COMMENT'?1"#"6N)
|
|---|
| 12 | .I $D(^TMP($J,"CONTACT",COMMENT)) D
|
|---|
| 13 | ..S DIK="^ONCO(165,",DA=XENTRY D ^DIK
|
|---|
| 14 | ..F PIEN=0:0 S PIEN=$O(^ONCO(165,"ACP",XENTRY,PIEN)) Q:PIEN'>"" D
|
|---|
| 15 | ...S CIEN=$G(^TMP($J,"CONTACT",COMMENT)),FUCIEN="" F RK=0:0 S RK=$O(^ONCO(160,PIEN,"C",RK)) Q:RK'>"" D
|
|---|
| 16 | ....Q:RK'>0
|
|---|
| 17 | ....I $P($G(^ONCO(160,PIEN,"C",RK,0)),"^",2)=XENTRY S FUCIEN=RK
|
|---|
| 18 | ....Q
|
|---|
| 19 | ...Q:FUCIEN=""
|
|---|
| 20 | ...S DIE="^ONCO(160,PIEN,""C"",",DA(1)=PIEN,DA=FUCIEN,DR="1///"_CIEN D ^DIE
|
|---|
| 21 | ...Q
|
|---|
| 22 | ..Q
|
|---|
| 23 | .I '$D(^TMP($J,"CONTACT",COMMENT)) S ^TMP($J,"CONTACT",COMMENT)=XENTRY
|
|---|
| 24 | .Q
|
|---|
| 25 | K ^TMP($J,"CONTACT"),XENTRY,COMMENT
|
|---|
| 26 | Q
|
|---|
