source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOFTS.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1ONCOFTS ;Hines OIFO/GWB - TUMOR STATUS/CANCER STATUS OF PRIMARY ;02/02/00
2 ;;2.11;ONCOLOGY;**24,25,47**;Mar 07, 1995;Build 19
3 ;
4STSM ;CREATE TUMOR STATUS MULTIPLE IN 165.5
5 ;called from "AE" cross-reference of DATE OF LAST CONTACT OR DEATH
6 ;Sub-field (#.01) of FOLLOW-UP Field (#400) of ONCOLOGY PATIENT (#160)
7 ;N VARIABLES
8 ;X=CURRENT FOLLOWUP DATE
9 ;DA=CURRENT FOLLOWUP MULTIPLE ENTRY
10 ;TUMOR STATUS
11 N MH,LC,K,XD1,XY,XDA1
12 I '$D(^ONCO(165.5,"C",DA(1))) W:'$D(ZTQUEUED) !!,?5,"Patient ",DA(1)," has no Primaries - cannot track Tumor Status",! ;NO PRIMARIES
13 E D STSMSET ;Set the primaries
14 Q
15 ;
16STSMSET ;Patient has primaries, so set
17 N CURFOLDT,PRIMARY
18 S CURFOLDT=X ;Current Follow-Up Date
19 S PRIMARY=0
20 F S PRIMARY=$O(^ONCO(165.5,"C",DA(1),PRIMARY)) Q:PRIMARY="" I $$DIV^ONCFUNC(PRIMARY)=DUZ(2) D
21 .N DATEDX
22 .S DATEDX=$P(^ONCO(165.5,PRIMARY,0),U,16)
23 .I DATEDX="" W:'$D(ZTQUEUED) !,?5," Patient ",DA(1),": DATE DX MISSING for "_$P(^ONCO(164.2,$P(^ONCO(165.5,PRIMARY,0),U),0),U),!?5," NO Tumor Status Followup Created",!!
24 .E I DATEDX'>CURFOLDT D STSMONE
25 Q
26 ;
27STSMONE ;Look for a corresponding tumor status for this primary, set up if none there
28 I '$D(^ONCO(165.5,PRIMARY,"TS","B",CURFOLDT)) D ;not defined, set up
29 .N TUMSTAT
30 .L +^ONCO(165.5,PRIMARY,"TS")
31 .S:'$D(^ONCO(165.5,PRIMARY,"TS",0)) ^(0)="^165.573DA" ;set header if undefined
32 .F TUMSTAT=$P(^ONCO(165.5,PRIMARY,"TS",0),U,3)+1:1 Q:'$D(^(TUMSTAT)) ;get index
33 .S ^ONCO(165.5,PRIMARY,"TS",TUMSTAT,0)=CURFOLDT ;set data
34 .S ^ONCO(165.5,PRIMARY,"TS","B",CURFOLDT,TUMSTAT)="" ;date xref
35 .S ^ONCO(165.5,PRIMARY,"TS","AA",9999999-CURFOLDT,TUMSTAT)="" ;inverted date xref
36 .S $P(^ONCO(165.5,PRIMARY,"TS",0),U,3)=TUMSTAT,$P(^(0),U,4)=$P(^(0),U,4)+1 ;update header
37 .L -^ONCO(165.5,PRIMARY,"TS")
38 Q
39 ;
40KTSM ;Delete TUMOR STATUS Multiple (#73) in ONCOLOGY PRIMARY File (#165.5)
41 ;corresponding to an entry in the FOLLOW-UP Multiple (#400) in ONCOLOGY PATIENT File (#160)
42 ;Called by KILL Logic of AE Cross-reference of DATE OF LAST CONTACT OR DEATH Sub-field (#.01) of FOLLOW-UP Multiple
43 ;Input DA(1) = internal entry number in ONCOLOGY PATIENT File
44 ; X = date of follow-up to be deleted
45 N XD1
46 S XD1=0 F S XD1=$O(^ONCO(165.5,"C",DA(1),XD1)) Q:'XD1 I $$DIV^ONCFUNC(XD1)=DUZ(2) D KTSMA
47 Q
48KTSMA I $D(^ONCO(165.5,XD1,"TS","B",X)) D
49 .N DIK,DR,DA
50 .S DA=0
51 .F S DA=$O(^ONCO(165.5,XD1,"TS","B",X,DA)) Q:'DA D KTSMONE ;kill
52 Q
53 ;
54KTSMONE ;kill a single tumor status sub-record
55 ;DEVELOPERS NOTE: The code is written this way because FileMan blows
56 ;up if you try to make a DIK call from within DIE. Thus this code
57 ;should always be modified if any changes are made to the TUMOR STATUS
58 ;multiple Field (#73) in the ONCOLOGY PRIMARY File (#165.5).
59 ;When FileMan gets his act together, this logic can be simplified
60 ;to a DIK call. MLH 4/14/93
61 ;
62 ;kill xrefs
63 K ^ONCO(165.5,XD1,"TS","B",X,DA) ;kill date xref (.01,B)
64 K ^ONCO(165.5,XD1,"TS","AA",9999999-X,DA) ;kill inverse date xref (.01,AA)
65 D LTS^ONCOU55(XD1,DA) ;reset LAST TUMOR STATUS Field (#95) (.02,AC)
66 K ^ONCO(165.5,XD1,"TS",DA) ;kill data
67 S $P(^ONCO(165.5,XD1,"TS",0),U,4)=$P($G(^ONCO(165.5,XD1,"TS",0)),U,4)-1 ;decrement count on header
68 Q
69 ;
70DX ;DATE OF LAST CONTACT OR DEATH (160.04,.01) Input Transform
71 ;At least one DATE DX (165.5,3) must precede DATE OF LAST CONTACT OR
72 ;DEATH
73 ;DATE OF LAST CONTACT OR DEATH must precede DATE@TIME OF DEATH (160,29)
74 N ONCOF,XD1
75 S ONCOF=0,XD1=0 F S XD1=$O(^ONCO(165.5,"C",DA(1),XD1)) Q:XD1'>0 S DATEDXZ=$P(^ONCO(165.5,XD1,0),U,16) I (DATEDXZ'>X)!(DATEDXZ="0000000")!(DATEDXZ=8888888)!(DATEDXZ=9999999) S ONCOF=1 Q
76 I 'ONCOF W !,"DATE DX must precede DATE OF LAST CONTACT OR DEATH",! K X
77 E D
78 .N ONCDTD
79 .S ONCDTD=$P($G(^ONCO(160,D0,1)),U,8)
80 .I $E(ONCDTD,6,7)="00" Q
81 .I ONCDTD,ONCDTD<X W !,"DATE OF LAST CONTACT OR DEATH must precede DATE@TIME OF DEATH" K X
82 Q
Note: See TracBrowser for help on using the repository browser.