source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOU55B.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1ONCOU55B ;WISC/MLH-UTILITY ROUTINE #3 for ONCOLOGY PRIMARY File (#165.5) ;9/10/93 10:08
2 ;;2.11;ONCOLOGY;;Mar 07, 1995
3 ;
4RXTS ; 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 ;
15RXTSD ; 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 ;
26RXTSD1 ; 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
Note: See TracBrowser for help on using the repository browser.