| [613] | 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
|
|---|
