source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPST4.m@ 901

Last change on this file since 901 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 982 bytes
Line 
1ONCOPST4 ;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
Note: See TracBrowser for help on using the repository browser.