source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPST2.m@ 808

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1ONCOPST2 ;HIRMFO/RTK-DATA CONVERSION CONTINUED ;2/7/96
2 ;;2.11;ONCOLOGY;**1,4**;Feb 07, 1996
3 ;
4 ;Routine to convert data in field 24.5 in the ONCOLOGY PATIENT file
5 ;from pntrs to ONCOLOGY CONTACT file to pntrs to new ACOS NUMBER file.
6 ;
7 S FIRST=$O(^ONCO(160,0)) Q:FIRST="" I $P($G(^ONCO(160,FIRST,10)),"^",1)="" D
8 .F XFIRST=0:0 S XFIRST=$O(^ONCO(160,XFIRST)) Q:XFIRST'>"" S $P(^ONCO(160,XFIRST,10),"^",1)="N"
9 F XPAT=0:0 S XPAT=$O(^ONCO(160,XPAT)) Q:XPAT'>0 D
10 .Q:$P($G(^ONCO(160,XPAT,10)),"^",1)'="N"
11 .S CCAD=$P($G(^ONCO(160,XPAT,1)),"^",11) I CCAD="" Q
12 .S CONTACT2=$G(^ONCO(165,CCAD,0)),NEWACOS2=$P($G(^ONCO(165,CCAD,0)),"^",4)
13 .I CONTACT2="" S DIE="^ONCO(160,",DA=XPAT,DR="24.5///@" D ^DIE S $P(^ONCO(160,XPAT,10),"^",1)="Y" Q
14 .I NEWACOS2=""!(NEWACOS2'?1"#"6N) S ^TMP($J,"CONTINV",CCAD)="",$P(^ONCO(160,XPAT,10),"^",1)="N" Q
15 .I NEWACOS2?1"#"6N S NEWACOS2=$E(NEWACOS2,2,7)
16 .S ACOSIEN2=$O(^ONCO(160.19,"B",NEWACOS2,"")) I ACOSIEN2="" S ^TMP($J,"NOTFND",CCAD)="",$P(^ONCO(160,XPAT,10),"^",1)="N" Q
17 .I ACOSIEN2'="" S $P(^ONCO(160,XPAT,1),"^",11)=ACOSIEN2,$P(^ONCO(160,XPAT,10),"^",1)="Y"
18 .Q
19 Q
Note: See TracBrowser for help on using the repository browser.