ONCODLF ;Hines OIFO/GWB - DISPLAY FOLLOW-UP DATA, ALL/LATEST ;07/23/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
LFS ;LAST FOLLOW-UP STATUS (from D0 #165.59 - computed primary
S XD0=$P(^ONCO(165.5,D0,0),U,2) G LF
;
LST ;Display last FOLLOW-UP (160,400) data
S (XD0,OD0)=D0
LF S XD1=$O(^ONCO(160,XD0,"F","AA",0)) G:XD1'>0 EX
S XD1=$O(^ONCO(160,XD0,"F","AA",XD1,0))
S XXD0=$S($D(^ONCO(160,XD0,"F",XD1)):^ONCO(160,XD0,"F",XD1,0),1:"")
S NL=$S($D(^ONCO(160,XD0,"F",XD1,1,0)):$P(^ONCO(160,XD0,"F",XD1,1,0),U,4),1:"")
D:XD1 WD G EX
;
FHC ;'COMPUTED-FIELD' EXPRESSION for HISTORY-FOLLOWUP (160,46)
S (OD0,XD0)=D0,LST=9999999,HIS=1
F N XXD1,OJ
S (XXD1,OJ)=0
F S XXD1=$O(^ONCO(160,XD0,"F","AA",XXD1)) S OJ=OJ+1 G END:XXD1'>0,END:XXD1>LST S XD1=$O(^ONCO(160,XD0,"F","AA",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
;End
END G EX:'$D(XD1)
D HD:OJ>1,C
S VS=$S($D(^ONCO(160,XD0,1)):$P(^ONCO(160,XD0,1),U),1:"")
G DEAD:VS=0,EX
;
DEAD ;DEATH INFORMATION
S D0=XD0 K DXS,DIOT D ^ONCOXDI G EX
;
FHP ;COMPUTED-FIELD' EXPRESSION for FOLLOW-UP HISTORY (165.5,150)
N FDAT,OJ
S (XD0,OD0)=D0
P S XD0=$G(^ONCO(165.5,XD0,0))
G EX:XD0=""
D DAT
S LST=9999999-XLC,XD0=$P(XD0,U,2)
S (XXD1,OJ)=0
F S XXD1=$O(^ONCO(160,XD0,"F","AA",XXD1)) S OJ=OJ+1 G FIN:XXD1'>0,FIN:XXD1>LST S XD1=$O(^ONCO(160,XD0,"F","AA",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
FIN G EX
;
DAT ;Get Reference date
S XLC=$P(XD0,U,16) Q:XLC'="" S XLC=$P(XD0,U,9) Q:XLC'="" S XLC=$P(XD0,U,8) Q
;
S YR=$P(XD0,U,7) I XDD'="" Q:($E(XDD,1,3)+1700)'<YR
S XDD=2_$E(YR,3,4)_"0000"
Q
HD ;header for Follow-up History
W "--------------------------------------------------------------------------------"
Q
;
WD F I=1:1:5 S X(I-1)=$P(XXD0,U,I)
S X(6)=$P(XXD0,U,6)
S X(11)=$P(XXD0,U,10)
S X(12)=$P(XXD0,U,11)
S X=X(0) D DATEOT^ONCOES S X(0)=X
1 S X=X(1),X(1)=$S(X=0:"Dead",X=1:"Alive",1:"")
3 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")
4 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")
6 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")
11 S X=X(11),X(11)=$P($G(^VA(200,+X,0)),U,1)
12 S X=X(12) D DATEOT^ONCOES S X(12)=X
W !?2,"Date of Last Contact or Death.:",?34,X(0)
I $G(FUQA)="QA" W ! Q
W !?2,"Vital Status..................:",?34,X(1)
W !?2,"Follow-up Source..............:",?34,X(3)
W !?2,"Next Follow-up Source.........:",?34,X(6)
W !?2,"Registrar.....................:",?34,X(11)
W !?2,"Date entered..................:",?34,X(12)
W !?2,"Comments:"
PC ;COMMENTS (160.45,.01)
S X=0
F I=0:0 S X=$O(^ONCO(160,XD0,"F",XD1,1,X)) Q:X'>0 W !?2,^ONCO(160,XD0,"F",XD1,1,X,0)
W !
;
C Q:$D(NL)
S NL=$S($D(^ONCO(160,XD0,"F",+XD1,1,0)):($P(^ONCO(160,XD0,"F",+XD1,1,0),U,4)+1),1:"")
S TL=6+NL Q:TL<(IOSL-($Y))
D HD
W #
I $D(^UTILITY($J,1)) X ^UTILITY($J,1) Q
W ?10,"*************** FOLLOWUP HISTORY ***************",!!
Q
DT 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
Q
N W !
T 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,^UTILITY($J,1)?1U1P1E X ^UTILITY($J,1)
Q
EX ;Kill and Exit
S D0=OD0 ;RESET wherever came from
K OD0,HIS,NL,XD1,XD0,I,X1,X2,XXD0,XX,VS S X=""
Q
;
CLEANUP ;Cleanup
K D0,D1,DIWF,DN,FUQA,LST,TL,X,XDD,XLC,Y,YR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCODLF 4012 printed Dec 13, 2024@02:24:49 Page 2
ONCODLF ;Hines OIFO/GWB - DISPLAY FOLLOW-UP DATA, ALL/LATEST ;07/23/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
LFS ;LAST FOLLOW-UP STATUS (from D0 #165.59 - computed primary
+1 SET XD0=$PIECE(^ONCO(165.5,D0,0),U,2)
GOTO LF
+2 ;
LST ;Display last FOLLOW-UP (160,400) data
+1 SET (XD0,OD0)=D0
LF SET XD1=$ORDER(^ONCO(160,XD0,"F","AA",0))
if XD1'>0
GOTO EX
+1 SET XD1=$ORDER(^ONCO(160,XD0,"F","AA",XD1,0))
+2 SET XXD0=$SELECT($DATA(^ONCO(160,XD0,"F",XD1)):^ONCO(160,XD0,"F",XD1,0),1:"")
+3 SET NL=$SELECT($DATA(^ONCO(160,XD0,"F",XD1,1,0)):$PIECE(^ONCO(160,XD0,"F",XD1,1,0),U,4),1:"")
+4 if XD1
DO WD
GOTO EX
+5 ;
FHC ;'COMPUTED-FIELD' EXPRESSION for HISTORY-FOLLOWUP (160,46)
+1 SET (OD0,XD0)=D0
SET LST=9999999
SET HIS=1
F NEW XXD1,OJ
+1 SET (XXD1,OJ)=0
+2 FOR
SET XXD1=$ORDER(^ONCO(160,XD0,"F","AA",XXD1))
SET OJ=OJ+1
if XXD1'>0
GOTO END
if XXD1>LST
GOTO END
SET XD1=$ORDER(^ONCO(160,XD0,"F","AA",XXD1,0))
SET XXD0=$GET(^ONCO(160,XD0,"F",XD1,0))
SET FDAT=$PIECE(XXD0,U)
KILL NL
if XXD0'=""
DO C
DO HD
SET D0=XD0
SET D1=XD1
DO MTS^ONCOCOFA
DO WD
+3 ;End
END if '$DATA(XD1)
GOTO EX
+1 if OJ>1
DO HD
DO C
+2 SET VS=$SELECT($DATA(^ONCO(160,XD0,1)):$PIECE(^ONCO(160,XD0,1),U),1:"")
+3 if VS=0
GOTO DEAD
GOTO EX
+4 ;
DEAD ;DEATH INFORMATION
+1 SET D0=XD0
KILL DXS,DIOT
DO ^ONCOXDI
GOTO EX
+2 ;
FHP ;COMPUTED-FIELD' EXPRESSION for FOLLOW-UP HISTORY (165.5,150)
+1 NEW FDAT,OJ
+2 SET (XD0,OD0)=D0
P SET XD0=$GET(^ONCO(165.5,XD0,0))
+1 if XD0=""
GOTO EX
+2 DO DAT
+3 SET LST=9999999-XLC
SET XD0=$PIECE(XD0,U,2)
+4 SET (XXD1,OJ)=0
+5 FOR
SET XXD1=$ORDER(^ONCO(160,XD0,"F","AA",XXD1))
SET OJ=OJ+1
if XXD1'>0
GOTO FIN
if XXD1>LST
GOTO FIN
SET XD1=$ORDER(^ONCO(160,XD0,"F","AA",XXD1,0))
SET XXD0=$GET(^ONCO(160,XD0,"F",XD1,0))
SET FDAT=$PIECE(XXD0,U)
KILL NL
DO HD
IF XXD0'=""
SET D0=XD0
SET D1=XD1
DO MTS^ONCOCOFA
DO WD
FIN GOTO EX
+1 ;
DAT ;Get Reference date
+1 SET XLC=$PIECE(XD0,U,16)
if XLC'=""
QUIT
SET XLC=$PIECE(XD0,U,9)
if XLC'=""
QUIT
SET XLC=$PIECE(XD0,U,8)
QUIT
+2 ;
+3 SET YR=$PIECE(XD0,U,7)
IF XDD'=""
if ($EXTRACT(XDD,1,3)+1700)'<YR
QUIT
+4 SET XDD=2_$EXTRACT(YR,3,4)_"0000"
+5 QUIT
HD ;header for Follow-up History
+1 WRITE "--------------------------------------------------------------------------------"
+2 QUIT
+3 ;
WD FOR I=1:1:5
SET X(I-1)=$PIECE(XXD0,U,I)
+1 SET X(6)=$PIECE(XXD0,U,6)
+2 SET X(11)=$PIECE(XXD0,U,10)
+3 SET X(12)=$PIECE(XXD0,U,11)
+4 SET X=X(0)
DO DATEOT^ONCOES
SET X(0)=X
1 SET X=X(1)
SET X(1)=$SELECT(X=0:"Dead",X=1:"Alive",1:"")
3 SET X=X(3)
SET X(3)=$SELECT(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")
4 SET X=X(4)
SET X(4)=$SELECT(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")
6 SET X=X(6)
SET X(6)=$SELECT(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")
11 SET X=X(11)
SET X(11)=$PIECE($GET(^VA(200,+X,0)),U,1)
12 SET X=X(12)
DO DATEOT^ONCOES
SET X(12)=X
+1 WRITE !?2,"Date of Last Contact or Death.:",?34,X(0)
+2 IF $GET(FUQA)="QA"
WRITE !
QUIT
+3 WRITE !?2,"Vital Status..................:",?34,X(1)
+4 WRITE !?2,"Follow-up Source..............:",?34,X(3)
+5 WRITE !?2,"Next Follow-up Source.........:",?34,X(6)
+6 WRITE !?2,"Registrar.....................:",?34,X(11)
+7 WRITE !?2,"Date entered..................:",?34,X(12)
+8 WRITE !?2,"Comments:"
PC ;COMMENTS (160.45,.01)
+1 SET X=0
+2 FOR I=0:0
SET X=$ORDER(^ONCO(160,XD0,"F",XD1,1,X))
if X'>0
QUIT
WRITE !?2,^ONCO(160,XD0,"F",XD1,1,X,0)
+3 WRITE !
+4 ;
C if $DATA(NL)
QUIT
+1 SET NL=$SELECT($DATA(^ONCO(160,XD0,"F",+XD1,1,0)):($PIECE(^ONCO(160,XD0,"F",+XD1,1,0),U,4)+1),1:"")
+2 SET TL=6+NL
if TL<(IOSL-($Y))
QUIT
+3 DO HD
+4 WRITE #
+5 IF $DATA(^UTILITY($JOB,1))
XECUTE ^UTILITY($JOB,1)
QUIT
+6 WRITE ?10,"*************** FOLLOWUP HISTORY ***************",!!
+7 QUIT
DT IF Y
WRITE $PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$EXTRACT(Y,4,5))_" "
if Y#100
WRITE $JUSTIFY(Y#100\1,2)_","
WRITE Y\10000+1700
if Y#1
WRITE " "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12)
QUIT
+1 QUIT
N WRITE !
T if $X
WRITE !
IF '$DATA(DIOT(2))
IF DN
IF $DATA(IOSL)
IF $SELECT('$DATA(DIWF):1,$PIECE(DIWF,"B",2):$PIECE(DIWF,"B",2),1:1)+$Y'<IOSL
IF $DATA(^UTILITY($JOB,1))#2
IF ^UTILITY($JOB,1)?1U1P1E
XECUTE ^UTILITY($JOB,1)
+1 QUIT
EX ;Kill and Exit
+1 ;RESET wherever came from
SET D0=OD0
+2 KILL OD0,HIS,NL,XD1,XD0,I,X1,X2,XXD0,XX,VS
SET X=""
+3 QUIT
+4 ;
CLEANUP ;Cleanup
+1 KILL D0,D1,DIWF,DN,FUQA,LST,TL,X,XDD,XLC,Y,YR
