Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOCRF

ONCOCRF.m

Go to the documentation of this file.
  1. ONCOCRF ;HINES OIFO/GWB - FOLLOW-UP ;07/13/00
  1. ;;2.2;ONCOLOGY;**1,5,13**;Jul 31, 2013;Build 7
  1. ;
  1. LD ;DATE OF LAST CONTACT OR DEATH (160.04,.01)
  1. N O1,O2,STOP S LD="",STOP=0
  1. S O1=""
  1. F S O1=$O(^ONCO(160,XD0,"F","B",O1)) Q:'O1 D Q:STOP
  1. .S O2=""
  1. .F S O2=$O(^ONCO(160,XD0,"F","B",O1,O2)) Q:'O2 D Q:STOP
  1. ..S LD=$G(^ONCO(160,XD0,"F",O2,0))
  1. ..I $P(LD,U,2)=0 S STOP=1 ;VITAL STATUS (160.04,1)="Dead"
  1. Q
  1. ;
  1. R1 ;Kill STATUS (160,15) "AS" and DUE FOLLOW-UP (160,27) "AD"
  1. ;cross-references
  1. S XD=$G(^ONCO(160,XD0,1)) Q:XD=""
  1. S OS=$P(XD,U,1) K:OS'="" ^ONCO(160,"AS",OS,XD0)
  1. S OD=$P(XD,U,2) K:OD'="" ^ONCO(160,"AD",OD,XD0)
  1. Q
  1. ;
  1. LDXT ;Return follow-up record for last date of contact excluding this one
  1. 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))
  1. Q
  1. ;
  1. SLF ;Set DATE OF LAST CONTACT OR DEATH (160.04,.01) "AA" cross-reference
  1. ;Set REGISTRAR (160.04,11) and DATE ENTERED (160.04)
  1. N ONCDUZ,ONCDT
  1. S XD0=DA(1),X1=9999999-X,^ONCO(160,XD0,"F","AA",X1,DA)=""
  1. S ONCDUZ=DUZ
  1. S ONCDT=DT
  1. S:$P(^ONCO(160,XD0,"F",DA,0),U,10)="" $P(^ONCO(160,XD0,"F",DA,0),U,10)=ONCDUZ
  1. S:$P(^ONCO(160,XD0,"F",DA,0),U,11)="" $P(^ONCO(160,XD0,"F",DA,0),U,11)=ONCDT
  1. G EX
  1. ;
  1. KLF ;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)
  1. ;CODE MODIFIED TO ELIMINATE FM RE-INDEXING DATA LOSS
  1. ;CHANGE MADE TO PREVENT DELETING DEATH DATA, IN FM CROSS-REFERENCING
  1. S XD0=DA(1),X1=9999999-X K ^ONCO(160,XD0,"F","AA",X1,DA) G EX
  1. ;
  1. SVS ;VITAL STATUS->STATUS (160,15) trigger AND UPDATE DUE FOLLOW-UP IF DEAD
  1. ;Invoked by "AC" xref on VITAL STATUS sub-field (160.04,1)
  1. S XD0=DA(1) D LD ;get the last sub-record alive (or the first dead)
  1. D UVS^ONCOCRFA ;update vital status
  1. Q
  1. ;
  1. KVS ;Kill: reset STATUS
  1. S XD0=DA(1) D LDXT ;get the last sub-record (excluding this one)
  1. D UVS^ONCOCRFA ;update vital status
  1. Q
  1. ;
  1. NF ;Set DUE FOLLOW-UP (160,27)
  1. S NF=$S(FS=0:"",1:$E(LC,1,3)+1_$E(LC,4,5)_"00")
  1. S $P(^ONCO(160,XD0,1),U,2)=NF
  1. I NF'="" S ^ONCO(160,"AD",NF,XD0)=""
  1. Q
  1. ;
  1. UPD ;Update the following fields with the most recent FOLLOW-UP (160,400)
  1. ;data:
  1. ;STATUS (160,15) 1;1
  1. ;FOLLOW-UP STATUS (160,15.2) 1;7
  1. ;ICD REVSION (160,20) 1;4
  1. ;DUE FOLLOW-UP (160,27) 1;2
  1. ;DATE@TIME OF DEATH (160,29) 1;8
  1. I '$D(XD0) Q:'$D(D0) S XD0=D0
  1. D LD,R1 G EX:LD=""
  1. S LC=$P(LD,U,1),ONCOVS=$P(LD,U,2),NM=$P(LD,U,6)
  1. S FS=0 D SGPRCOC I DNTSKP=1 S FS=$S(NM="":1,NM<8:1,ONCOVS=0:0,1:0)
  1. I FS S X1=DT,X2=LC D ^%DTC S FS=$S(X>456.25:8,1:FS)
  1. S DIE="^ONCO(160,",DA=XD0,DR="15///"_ONCOVS_";15.2///"_FS D ^DIE
  1. K DIE,DR
  1. S $P(^ONCO(160,XD0,1),U,4)=$S(ONCOVS=0:9,1:0)
  1. D NF I FS S Y=NF D DD^%DT W !!?20,"Due follow-up: ",Y G EX
  1. S:ONCOVS=0 $P(^ONCO(160,XD0,1),U,8)=LC
  1. W !!," Patient not followed"
  1. G EX
  1. ;
  1. SGPRCOC ;CHECK IF PATIENT HAS SINGLE PRIMARY ONLY & CLASS OF CASE 00 OR 30-99
  1. ;called from UDP above when setting FS for Follow-Up Source
  1. ; don't set FS to 1 (Active) or 8 (LTF) if single primary, COC 00,30-99
  1. S DNTSKP=1
  1. S PRI=0,PRICNT=0 F S PRI=$O(^ONCO(165.5,"C",XD0,PRI)) Q:PRI'>0 I $P($G(^ONCO(165.5,PRI,"DIV")),U,1)=DUZ(2) D
  1. .S PRICNT=PRICNT+1
  1. I PRICNT=1 D ; if patient has exactly 1 primary
  1. .S ZZPRENT=$O(^ONCO(165.5,"C",XD0,0)) Q:ZZPRENT'>0 ; get primary IEN
  1. .S ZZPRCOC=$P($G(^ONCO(165.5,ZZPRENT,0)),"^",4) ; get the COC
  1. .I ZZPRCOC=1!(ZZPRCOC>9) S DNTSKP=0
  1. K PRI,PRICNT,ZZPRENT,ZZPRCOC
  1. Q
  1. CHKDT04 ;
  1. N X S X=$P($G(^ONCO(165.5,D0,0)),"^",16) I X>3031231 D
  1. .S ONCSITGP=$P($G(^ONCO(165.5,D0,0)),"^",1) W ?48,$E($P($G(^ONCO(164.2,ONCSITGP,0)),"^",1),1,20) D DATEOT^ONCOES W ?69,X
  1. Q
  1. LFU ;LAST FOLLOW-UP SUMMARY-SELECTED DATA from Last Follow-up
  1. S XD0=D0 D GD I X="" W !?10,"NO Last Contact Information on Patient",! G EX
  1. DLC ;DATE LAST CONTACT (160,16) from "AF" cross-reference
  1. S XD0=D0 D GD G EX
  1. ;
  1. CAS ;CANCER STATUS Last Date Contact
  1. DOD ;computed Date of Death
  1. I $D(^ONCO(160,D0,1)),$P(^(1),U,1)=0 G DLC
  1. S X="" G EX
  1. GD ;DATE LAST CONTACT (160,16)
  1. S X=$S('$D(^ONCO(160,XD0,"F","AA")):"",1:9999999-$O(^ONCO(160,XD0,"F","AA",0)))
  1. Q
  1. ;
  1. PDLC ;DATE LAST CONTACT (165.5,200)
  1. S X=$S('$D(^ONCO(165.5,D0,"TS","AA")):"",1:9999999-$O(^ONCO(165.5,D0,"TS","AA",0))) G EX
  1. ;
  1. PDLC1 ;DATE LAST CONTACT FILMANAGER FORMAT
  1. D P0 G EX:XD0="" D GD G EX
  1. ;
  1. P0 S XD0=$P($G(^ONCO(165.5,D0,0)),U,2)
  1. Q
  1. ;
  1. SDA ;SURVIVAL DAYS
  1. D P0 G EX:XD0="" D SD G EX ;PRESENTS SURVIVAL IN DAYS
  1. ;
  1. SUR ;SURVIVAL (MONTHS)
  1. D P0 G EX:XD0="" D SD G EX:X="" S X=X/30.4375 G EX
  1. ;
  1. SYR ;SURVIVAL YEARS
  1. D P0 G EX:XD0="" D SD G EX:X="" S X=X/365.25 G EX
  1. ;
  1. SWK ;WEEKS FOLLOWUP
  1. D P0 G EX:XD0="" D SD G EX:X="" S X=X/7 G EX
  1. ;
  1. SD S XDX=$P(^ONCO(165.5,D0,0),U,16) D GD,DC
  1. Q
  1. DC ;DATE COMPARE
  1. S X2=XDX,X1=X S X=$S(X2="":"",X1="":"",1:0) Q:X="" I X2>X1 S X="" Q
  1. D ^%DTC Q
  1. DD ;DATE FORMATING
  1. 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))
  1. Q
  1. SDF ;DUE FOLLOW-UP-TIGGERED BY NEXT FOLLOW-UP METHOD of FOLLOW-UP MULTIPLE
  1. Q
  1. KDF ;KILL DUE FOLLOW-UP
  1. Q
  1. ;
  1. EX ;KILL variables
  1. K DNTSKP,FS,LC,LD,NF,NM,OD,ONCDT,ONCDUZ,ONCVS,OS,X1,X2,XD,XD0,XDX,Y
  1. Q