27 lines
982 B
Mathematica
27 lines
982 B
Mathematica
ONCOPST4 ;HIRMFO/RTK-ROUTINE TO CLEAN UP FILE 165 ;2/21/96
|
|
;;2.11;ONCOLOGY;**1**;Feb 21, 1996
|
|
;
|
|
; Routine to loop thru ONCOLOGY CONTACT file (#165) and clean up
|
|
; any duplicate entries.
|
|
;
|
|
W !!,"Cleaning up duplicate entries in ONCOLOGY CONTACT (#165) file..."
|
|
K ^TMP($J,"CONTACT")
|
|
F XENTRY=0:0 S XENTRY=$O(^ONCO(165,XENTRY)) Q:XENTRY'>"" D
|
|
.S COMMENT=$P($G(^ONCO(165,XENTRY,0)),"^",4)
|
|
.Q:COMMENT=""!(COMMENT'?1"#"6N)
|
|
.I $D(^TMP($J,"CONTACT",COMMENT)) D
|
|
..S DIK="^ONCO(165,",DA=XENTRY D ^DIK
|
|
..F PIEN=0:0 S PIEN=$O(^ONCO(165,"ACP",XENTRY,PIEN)) Q:PIEN'>"" D
|
|
...S CIEN=$G(^TMP($J,"CONTACT",COMMENT)),FUCIEN="" F RK=0:0 S RK=$O(^ONCO(160,PIEN,"C",RK)) Q:RK'>"" D
|
|
....Q:RK'>0
|
|
....I $P($G(^ONCO(160,PIEN,"C",RK,0)),"^",2)=XENTRY S FUCIEN=RK
|
|
....Q
|
|
...Q:FUCIEN=""
|
|
...S DIE="^ONCO(160,PIEN,""C"",",DA(1)=PIEN,DA=FUCIEN,DR="1///"_CIEN D ^DIE
|
|
...Q
|
|
..Q
|
|
.I '$D(^TMP($J,"CONTACT",COMMENT)) S ^TMP($J,"CONTACT",COMMENT)=XENTRY
|
|
.Q
|
|
K ^TMP($J,"CONTACT"),XENTRY,COMMENT
|
|
Q
|