| [613] | 1 | ONCOU55B ;WISC/MLH-UTILITY ROUTINE #3 for ONCOLOGY PRIMARY File (#165.5) ;9/10/93 10:08
|
|---|
| 2 | ;;2.11;ONCOLOGY;;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | RXTS ; reindex TUMOR STATUS (#73) on ONCOLOGY PRIMARY (#165.5) - called by RXTS^ONCOU55
|
|---|
| 5 | ; should only be run after re-indexing follow-up (RXFU^ONCOU0)
|
|---|
| 6 | N KT,DA
|
|---|
| 7 | N KTS S KTS=0
|
|---|
| 8 | W:'$D(ZTQUEUED) !!,"Re-indexing TUMOR STATUS" S DA(1)=0
|
|---|
| 9 | F KT=1:1 S DA(1)=$O(^ONCO(165.5,DA(1))) Q:'DA(1) D RXTSD
|
|---|
| 10 | ;END FOR
|
|---|
| 11 | ;
|
|---|
| 12 | W:'$D(ZTQUEUED) !,KT," primaries processed.",!,KTS," tumor statuses deleted lacking corresponding followups.",!!
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | RXTSD ; check FU tumor statuses for a primary - called by RXTS
|
|---|
| 16 | S DA=0
|
|---|
| 17 | F S DA=$O(^ONCO(165.5,DA(1),"TS",DA)) Q:'DA D RXTSD1 ; check a single follow up
|
|---|
| 18 | ;
|
|---|
| 19 | ; re-index all xrefs on the .01 field
|
|---|
| 20 | N DIK S DIK="^ONCO(165.5,"_DA(1)_",""TS"",",DIK(1)=.01
|
|---|
| 21 | K ^ONCO(165.5,DA(1),"TS","AA"),^("B")
|
|---|
| 22 | D ENALL^DIK,LTS^ONCOU55(DA(1))
|
|---|
| 23 | I '$D(ZTQUEUED) W:$R(100)=0 "."
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | RXTSD1 ; check a single follow up, delete if dangling - called by RXTSD
|
|---|
| 27 | N TSDAT S TSDAT=$P($G(^ONCO(165.5,DA(1),"TS",DA,0)),U,1)
|
|---|
| 28 | N PAT S PAT=$P($G(^ONCO(165.5,DA(1),0)),U,2)
|
|---|
| 29 | I TSDAT,PAT,$D(^ONCO(160,PAT,"F","B",TSDAT)) ; all OK
|
|---|
| 30 | E K ^ONCO(165.5,DA(1),"TS",DA) W "*" S KTS=KTS+1 ; no match - delete
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | QUIT
|
|---|
