1 | ONCOPST2 ;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
|
---|