34 lines
1.2 KiB
Mathematica
34 lines
1.2 KiB
Mathematica
ONCOU55B ;WISC/MLH-UTILITY ROUTINE #3 for ONCOLOGY PRIMARY File (#165.5) ;9/10/93 10:08
|
|
;;2.11;ONCOLOGY;;Mar 07, 1995
|
|
;
|
|
RXTS ; reindex TUMOR STATUS (#73) on ONCOLOGY PRIMARY (#165.5) - called by RXTS^ONCOU55
|
|
; should only be run after re-indexing follow-up (RXFU^ONCOU0)
|
|
N KT,DA
|
|
N KTS S KTS=0
|
|
W:'$D(ZTQUEUED) !!,"Re-indexing TUMOR STATUS" S DA(1)=0
|
|
F KT=1:1 S DA(1)=$O(^ONCO(165.5,DA(1))) Q:'DA(1) D RXTSD
|
|
;END FOR
|
|
;
|
|
W:'$D(ZTQUEUED) !,KT," primaries processed.",!,KTS," tumor statuses deleted lacking corresponding followups.",!!
|
|
Q
|
|
;
|
|
RXTSD ; check FU tumor statuses for a primary - called by RXTS
|
|
S DA=0
|
|
F S DA=$O(^ONCO(165.5,DA(1),"TS",DA)) Q:'DA D RXTSD1 ; check a single follow up
|
|
;
|
|
; re-index all xrefs on the .01 field
|
|
N DIK S DIK="^ONCO(165.5,"_DA(1)_",""TS"",",DIK(1)=.01
|
|
K ^ONCO(165.5,DA(1),"TS","AA"),^("B")
|
|
D ENALL^DIK,LTS^ONCOU55(DA(1))
|
|
I '$D(ZTQUEUED) W:$R(100)=0 "."
|
|
Q
|
|
;
|
|
RXTSD1 ; check a single follow up, delete if dangling - called by RXTSD
|
|
N TSDAT S TSDAT=$P($G(^ONCO(165.5,DA(1),"TS",DA,0)),U,1)
|
|
N PAT S PAT=$P($G(^ONCO(165.5,DA(1),0)),U,2)
|
|
I TSDAT,PAT,$D(^ONCO(160,PAT,"F","B",TSDAT)) ; all OK
|
|
E K ^ONCO(165.5,DA(1),"TS",DA) W "*" S KTS=KTS+1 ; no match - delete
|
|
Q
|
|
;
|
|
QUIT
|