20 lines
1.1 KiB
Mathematica
20 lines
1.1 KiB
Mathematica
ONCOPST2 ;HIRMFO/RTK-DATA CONVERSION CONTINUED ;2/7/96
|
|
;;2.11;ONCOLOGY;**1,4**;Feb 07, 1996
|
|
;
|
|
;Routine to convert data in field 24.5 in the ONCOLOGY PATIENT file
|
|
;from pntrs to ONCOLOGY CONTACT file to pntrs to new ACOS NUMBER file.
|
|
;
|
|
S FIRST=$O(^ONCO(160,0)) Q:FIRST="" I $P($G(^ONCO(160,FIRST,10)),"^",1)="" D
|
|
.F XFIRST=0:0 S XFIRST=$O(^ONCO(160,XFIRST)) Q:XFIRST'>"" S $P(^ONCO(160,XFIRST,10),"^",1)="N"
|
|
F XPAT=0:0 S XPAT=$O(^ONCO(160,XPAT)) Q:XPAT'>0 D
|
|
.Q:$P($G(^ONCO(160,XPAT,10)),"^",1)'="N"
|
|
.S CCAD=$P($G(^ONCO(160,XPAT,1)),"^",11) I CCAD="" Q
|
|
.S CONTACT2=$G(^ONCO(165,CCAD,0)),NEWACOS2=$P($G(^ONCO(165,CCAD,0)),"^",4)
|
|
.I CONTACT2="" S DIE="^ONCO(160,",DA=XPAT,DR="24.5///@" D ^DIE S $P(^ONCO(160,XPAT,10),"^",1)="Y" Q
|
|
.I NEWACOS2=""!(NEWACOS2'?1"#"6N) S ^TMP($J,"CONTINV",CCAD)="",$P(^ONCO(160,XPAT,10),"^",1)="N" Q
|
|
.I NEWACOS2?1"#"6N S NEWACOS2=$E(NEWACOS2,2,7)
|
|
.S ACOSIEN2=$O(^ONCO(160.19,"B",NEWACOS2,"")) I ACOSIEN2="" S ^TMP($J,"NOTFND",CCAD)="",$P(^ONCO(160,XPAT,10),"^",1)="N" Q
|
|
.I ACOSIEN2'="" S $P(^ONCO(160,XPAT,1),"^",11)=ACOSIEN2,$P(^ONCO(160,XPAT,10),"^",1)="Y"
|
|
.Q
|
|
Q
|