- 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 Jan 18, 2025@03:25:59 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