source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOCRF.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: 4.2 KB
Line 
1ONCOCRF ;Hines OIFO/GWB - FOLLOW-UP ;07/13/00
2 ;;2.11;ONCOLOGY;**6,11,16,22,25,26,28,44,45**;Mar 07, 1995
3LD ;Get node for DATE OF LAST CONTACT OR DEATH (160.04,.01)
4 N O1,O2,STOP S LD="",STOP=0
5 S O1=""
6 F S O1=$O(^ONCO(160,XD0,"F","B",O1)) Q:'O1 D Q:STOP
7 .S O2=""
8 .F S O2=$O(^ONCO(160,XD0,"F","B",O1,O2)) Q:'O2 D Q:STOP
9 ..S LD=$G(^ONCO(160,XD0,"F",O2,0))
10 ..I $P(LD,U,2)=0 S STOP=1 ;VITAL STATUS (160.04,1)="Dead"
11 Q
12 ;
13R1 ;Kill STATUS (160,15) "AS" and DUE FOLLOW-UP (160,27) "AD"
14 ;cross-references
15 S XD=$G(^ONCO(160,XD0,1)) Q:XD=""
16 S OS=$P(XD,U,1) K:OS'="" ^ONCO(160,"AS",OS,XD0)
17 S OD=$P(XD,U,2) K:OD'="" ^ONCO(160,"AD",OD,XD0)
18 Q
19 ;
20LDXT ;Return follow-up record for last date of contact excluding this one
21 S LD=$O(^ONCO(160,XD0,"F","AA",0)) I LD'="" S:$D(^(LD,DA)) LD=$O(^ONCO(160,XD0,"F","AA",LD)) I LD'="" S LD=+$O(^(LD,0)),LD=$G(^ONCO(160,XD0,"F",LD,0))
22 Q
23 ;
24SLF ;Set DATE OF LAST CONTACT OR DEATH (160.04,.01) "AA" cross-reference
25 ;Set REGISTRAR (160.04,11) and DATE ENTERED (160.04)
26 S XD0=DA(1),X1=9999999-X,^ONCO(160,XD0,"F","AA",X1,DA)=""
27 I $D(ONCDUZ) S $P(^ONCO(160,XD0,"F",DA,0),U,10)=ONCDUZ
28 I $D(ONCDT) S $P(^ONCO(160,XD0,"F",DA,0),U,11)=ONCDT
29 G EX
30 ;
31KLF ;Kill .01 of FOLLOW-UP MULTIPLE-RESETS: #16(1;2), STATUS #15(1;1), FOLLOWUP STATUS #15.2(1;7), DUE FOLLOW-UP #27(2;3), if alive, DATE DEATH #29 (1;8)
32 ;CODE MODIFIED TO ELIMINATE FM RE-INDEXING DATA LOSS
33 ;CHANGE MADE TO PREVENT DELETING DEATH DATA, IN FM CROSS-REFERENCING
34 S XD0=DA(1),X1=9999999-X K ^ONCO(160,XD0,"F","AA",X1,DA) G EX
35 ;
36SVS ;VITAL STATUS->STATUS (160,15) trigger AND UPDATE DUE FOLLOW-UP IF DEAD
37 ;Invoked by "AC" xref on VITAL STATUS sub-field (160.04,1)
38 S XD0=DA(1) D LD ;get the last sub-record alive (or the first dead)
39 D UVS^ONCOCRFA ;update vital status
40 Q
41 ;
42KVS ;Kill: reset STATUS
43 S XD0=DA(1) D LDXT ;get the last sub-record (excluding this one)
44 D UVS^ONCOCRFA ;update vital status
45 Q
46 ;
47NF ;Set DUE FOLLOW-UP (160,27)
48 S NF=$S(FS=0:"",1:$E(LC,1,3)+1_$E(LC,4,5)_"00")
49 S $P(^ONCO(160,XD0,1),U,2)=NF
50 I NF'="" S ^ONCO(160,"AD",NF,XD0)=""
51 Q
52 ;
53UPD ;Update the following fields with the most recent FOLLOW-UP (160,400)
54 ;data:
55 ;STATUS (160,15) 1;1
56 ;FOLLOW-UP STATUS (160,15.2) 1;7
57 ;ICD REVSION (160,20) 1;4
58 ;DUE FOLLOW-UP (160,27) 1;2
59 ;DATE@TIME OF DEATH (160,29) 1;8
60 I '$D(XD0) Q:'$D(D0) S XD0=D0
61 D LD,R1 G EX:LD=""
62 S LC=$P(LD,U,1),ONCOVS=$P(LD,U,2),NM=$P(LD,U,6)
63 S FS=$S(NM="":1,NM<8:1,ONCOVS=0:0,1:0)
64 I FS S X1=DT,X2=LC D ^%DTC S FS=$S(X>456.25:8,1:FS)
65 S $P(^ONCO(160,XD0,1),U,1)=ONCOVS,^ONCO(160,"AS",ONCOVS,XD0)=""
66 S $P(^ONCO(160,XD0,1),U,7)=FS,$P(^(1),U,4)=$S(ONCOVS=0:9,1:0)
67 D NF I FS S Y=NF D DD^%DT W !!?20,"Due follow-up: ",Y G EX
68 S:ONCOVS=0 $P(^ONCO(160,XD0,1),U,8)=LC
69 W !!," Patient not followed"
70 G EX
71 ;
72LFU ;LAST FOLLOW-UP SUMMARY-SELCTED DATA from Last Follow-up
73 S XD0=D0 D GD I X="" W !?10,"NO Last Contact Information on Patient",! G EX
74DLC ;DATE LAST CONTACT (160,16) from "AF" cross-reference
75 S XD0=D0 D GD G EX
76 ;
77CAS ;CANCER STATUS Last Date Contact
78DOD ;computed Date of Death
79 I $D(^ONCO(160,D0,1)),$P(^(1),U,1)=0 G DLC
80 S X="" G EX
81GD ;DATE LAST CONTACT (160,16)
82 S X=$S('$D(^ONCO(160,XD0,"F","AA")):"",1:9999999-$O(^ONCO(160,XD0,"F","AA",0)))
83 Q
84 ;
85PDLC ;DATE LAST CONTACT (165.5,200)
86 S X=$S('$D(^ONCO(165.5,D0,"TS","AA")):"",1:9999999-$O(^ONCO(165.5,D0,"TS","AA",0))) G EX
87 ;
88PDLC1 ;DATE LAST CONTACT FILMANAGER FORMAT
89 D P0 G EX:XD0="" D GD G EX
90 ;
91P0 S XD0=$P($G(^ONCO(165.5,D0,0)),U,2)
92 Q
93 ;
94SDA ;SURVIVAL DAYS
95 D P0 G EX:XD0="" D SD G EX ;PRESENTS SURVIVAL IN DAYS
96 ;
97SUR ;SURVIVAL (MONTHS)
98 D P0 G EX:XD0="" D SD G EX:X="" S X=X/30.4375 G EX
99 ;
100SYR ;SURVIVAL YEARS
101 D P0 G EX:XD0="" D SD G EX:X="" S X=X/365.25 G EX
102 ;
103SWK ;WEEKS FOLLOWUP
104 D P0 G EX:XD0="" D SD G EX:X="" S X=X/7 G EX
105 ;
106SD S XDX=$P(^ONCO(165.5,D0,0),U,16) D GD,DC
107 Q
108DC ;DATE COMPARE
109 S X2=XDX,X1=X S X=$S(X2="":"",X1="":"",1:0) Q:X="" I X2>X1 S X="" Q
110 D ^%DTC Q
111DD ;DATE FORMATING
112 S XD=$S(XD="":"",$E(XD,6,7)="00":$E(XD,4,5)_"/"_($E(XD,1,3)+1700),1:$E(XD,4,5)_"/"_$E(XD,6,7)_"/"_($E(XD,1,3)+1700))
113 Q
114SDF ;DUE FOLLOW-UP-TIGGERED BY NEXT FOLLOW-UP METHOD of FOLLOW-UP MULTIPLE
115 Q
116KDF ;KILL DUE FOLLOW-UP
117 Q
118EX ;KILL VARAIBLES and EXIT
119 K ONCODF,FS,NF,LC,LD,XD0,FVS,X1,XD,Y,XX
120 Q
Note: See TracBrowser for help on using the repository browser.