source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCODLF.m@ 1087

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1ONCODLF ;Hines OIFO/GWB - DISPLAY FOLLOW-UP DATA, ALL/LATEST ;03/08/00
2 ;;2.11;ONCOLOGY;**16,25,44,45**;Mar 07, 1995
3 ;
4LFS ;LAST FOLLOW-UP STATUS (from D0 #165.59 - computed primary
5 S XD0=$P(^ONCO(165.5,D0,0),U,2) G LF
6 ;
7LST ;Display last FOLLOW-UP (160,400) data
8 S (XD0,OD0)=D0
9LF S XD1=$O(^ONCO(160,XD0,"F","AA",0)) G:XD1'>0 EX S XD1=$O(^(XD1,0)),XXD0=$S($D(^ONCO(160,XD0,"F",XD1)):^(XD1,0),1:""),NL=$S($D(^ONCO(160,XD0,"F",XD1,1,0)):$P(^(0),U,4),1:"") D:XD1 WD G EX
10 ;
11FHC ;HISTORY-FOLLOWUP (COMPLETE) #46;D0=#160
12 S (OD0,XD0)=D0,LST=9999999,HIS=1
13F N XXD1,OJ S (XXD1,OJ)=0
14 F S XXD1=$O(^ONCO(160,XD0,"F","AA",XXD1)) S OJ=OJ+1 G END:XXD1'>0,END:XXD1>LST S XD1=$O(^(XXD1,0)),XXD0=$G(^ONCO(160,XD0,"F",XD1,0)),FDAT=$P(XXD0,U) K NL D C:XXD0'="",HD S D0=XD0,D1=XD1 D MTS^ONCOCOFA,WD
15END ;End follow-up
16 G EX:'$D(XD1) D HD:OJ>1,C S VS=$S($D(^ONCO(160,XD0,1)):$P(^(1),U),1:"") G DEAD:VS=0,EX
17 ;
18DEAD ;DEATH INFORMATION
19 S D0=XD0 K DXS,DIOT D ^ONCOXDI G EX
20 ;
21FHP ;FOLLOW-UP HISTORY #150 (for particular primary):D0=#165.5
22 N FDAT,OJ
23 S (XD0,OD0)=D0
24P S XD0=$G(^ONCO(165.5,XD0,0)) G EX:XD0="" D DAT S LST=9999999-XLC,XD0=$P(XD0,U,2)
25 S (XXD1,OJ)=0
26 ;F S XXD1=$O(^ONCO(160,XD0,"F","AA",XXD1)) S OJ=OJ+1 G FIN:XXD1'>0,FIN:XXD1>LST S XD1=$O(^(XXD1,0)),XXD0=$G(^ONCO(160,XD0,"F",XD1,0)),FDAT=$P(XXD0,U) K NL D C:XXD0'="",HD I XXD0'="" S D0=XD0,D1=XD1 D MTS^ONCOCOFA,WD
27 F S XXD1=$O(^ONCO(160,XD0,"F","AA",XXD1)) S OJ=OJ+1 G FIN:XXD1'>0,FIN:XXD1>LST S XD1=$O(^(XXD1,0)),XXD0=$G(^ONCO(160,XD0,"F",XD1,0)),FDAT=$P(XXD0,U) K NL D HD I XXD0'="" S D0=XD0,D1=XD1 D MTS^ONCOCOFA,WD
28FIN G EX
29 ;D:OJ>1 HD G EX
30 ;
31DAT ;Get Reference date
32 S XLC=$P(XD0,U,16) Q:XLC'="" S XLC=$P(XD0,U,9) Q:XLC'="" S XLC=$P(XD0,U,8) Q
33 ;
34 S YR=$P(XD0,U,7) I XDD'="" Q:($E(XDD,1,3)+1700)'<YR
35 S XDD=2_$E(YR,3,4)_"0000"
36 Q
37HD ;header for Follow-up History
38 W "--------------------------------------------------------------------------------"
39 Q
40 ;
41WD F I=1:1:5 S X(I-1)=$P(XXD0,U,I)
42 S X(6)=$P(XXD0,U,6)
43 S X(11)=$P(XXD0,U,10)
44 S X(12)=$P(XXD0,U,11)
45 S X=X(0) D DATEOT^ONCOES S X(0)=X
461 S X=X(1),X(1)=$S(X=0:"Dead",X=1:"Alive",1:"")
473 S X=X(3),X(3)=$S(X=0:"Reported Hospitalization",X=1:"Readmission",X=2:"Physician",X=3:"Patient",X=4:"Department of Motor Vehicles",X=5:"Medicare/Medicaid file",X=7:"Death certificate",X=8:"Other",1:"Unknown")
484 S X=X(4),X(4)=$S(X=0:"Normal",X=1:"Symptomatic & Ambulatory",X=2:"More than 50% Ambulatory",X=3:"Less than 50% Ambulatory",X=4:"Bedridden",X=8:"Not applicable, dead",1:"Unknown or unspecified")
496 S X=X(6),X(6)=$S(X=0:"Chart requisition",X=1:"Physician letter",X=2:"Contact letter",X=3:"Phone call",X=4:"Other hospital contact",X=5:"Other, NOS",X=8:"Foreign residents (not followed)",1:"Not followed")
5011 S X=X(11),X(11)=$P($G(^VA(200,+X,0)),U,1)
5112 S X=X(12) D DATEOT^ONCOES S X(12)=X
52 ;W !?1,"Last Contact: ",?15,X(0),?30,"F-U Method: ",?47,X(3)
53 ;W !?1,"Vital Status: ",?15,X(1),?30,"Quality of Surv: ",?47,X(4)
54 ;W !?1,"Date entered: ",?15,X(12),?30,"Next F-U Method: ",?47,X(6)
55 ;W !?1,"Registrar: ",?15,X(11)
56 W !?2,"Date of Last Contact or Death.:",?34,X(0)
57 I $G(FUQA)="QA" W ! Q
58 W !?2,"Vital Status..................:",?34,X(1)
59 W !?2,"Follow-up Source..............:",?34,X(3)
60 W !?2,"Next Follow-up Source.........:",?34,X(6)
61 W !?2,"Quality of Survival...........:",?34,X(4)
62 W !?2,"Registrar.....................:",?34,X(11)
63 W !?2,"Date entered..................:",?34,X(12)
64 ;Q:NL="" W !!," Comments:"
65 W !?2,"Comments:"
66PC S X=0 F I=0:0 S X=$O(^ONCO(160,XD0,"F",XD1,1,X)) Q:X'>0 W !?2,^(X,0)
67 W !
68 ;
69C Q:$D(NL) S NL=$S($D(^ONCO(160,XD0,"F",+XD1,1,0)):($P(^(0),U,4)+1),1:""),TL=6+NL Q:TL<(IOSL-($Y)) D HD W # I $D(^UTILITY($J,1)) X ^(1) Q
70 W ?10,"*************** FOLLOWUP HISTORY ***************",!!
71 Q
72DT I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
73 Q
74N W !
75T W:$X ! I '$D(DIOT(2)),DN,$D(IOSL),$S('$D(DIWF):1,$P(DIWF,"B",2):$P(DIWF,"B",2),1:1)+$Y'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E X ^(1)
76 Q
77EX ;Kill and Exit
78 S D0=OD0 ;RESET wherever came from
79 K OD0,HIS,NL,XD1,XD0,I,X1,X2,XXD0,XX,VS S X=""
80 Q
Note: See TracBrowser for help on using the repository browser.