ONCOPA3A ;Hines OIFO/RTK - [PA Print Complete Abstract (132c) ;03/11/11
;;2.2;ONCOLOGY;**1,12**;Jul 31, 2013;Build 8
;[PA Print Complete Abstract (132c)] continued
S NAME="FOLLOW-UP HISTORY" D FORMAT^ONCOPA1
W !!,TITLE,!
I $D(^ONCO(160,PTIEN,"F",0)) D FH Q:EX=U
W !!," Date of Last Contact: ",ONCAB(165.5,IEN,200)
W ?50," Last Tumor Status: ",ONCAB(165.5,IEN,95) D P Q:EX=U
W !!," Date of Death: ",ONCAB(160,PTIEN,29) D P Q:EX=U
W !," Cause of Death/Cancer: ",ONCAB(160,PTIEN,18.9) D P Q:EX=U
;W !," ICD Cause of Death: ",ONCAB(160,PTIEN,19)," "
;S ICDCD=$P($G(^ONCO(160,PTIEN,1)),U,3) I ICDCD'="" S IC=$$ICDDX^ICDCODE(ICDCD) I +IC'=-1 W $P(IC,U,4) D P Q:EX=U
;W !," State Death Cert: ",$P($G(^ONCO(160,PTIEN,1)),U,14)," ",ONCAB(160,PTIEN,19.1) D P Q:EX=U
;W !," ICD Revision: ",ONCAB(160,PTIEN,20) D P Q:EX=U
W !," Place of Death: ",ONCAB(160,PTIEN,21) D P Q:EX=U
W !," Care Center at Death: ",ONCAB(160,PTIEN,24.5) D P Q:EX=U
W !," Autopsy: ",ONCAB(160,PTIEN,22.9) D P Q:EX=U
W !," Autopsy Date/Time: ",ONCAB(160,PTIEN,23) D P Q:EX=U
W !," Autopsy No.: ",ONCAB(160,PTIEN,24) D P Q:EX=U
W !," Path/Autopsy: " F PATH=0:0 S PATH=$O(^ONCO(160,PTIEN,4,PATH)) Q:PATH'>0 W !?8,$G(^ONCO(160,PTIEN,4,PATH,0)) D P Q:EX=U
I $P($G(^ONCO(160,PTIEN,1)),U,1)=0 W !!?30,"TUMOR Status at DEATH (Multiple Primaries)",! S CNTR=1 F PRI=0:0 S PRI=$O(^ONCO(165.5,"C",PTIEN,PRI)) Q:PRI'>0 I $$DIV^ONCFUNC(PRI)=DUZ(2) D
.S ZN=$G(^ONCO(165.5,PRI,0)) Q:ZN=""
.S CNTR=CNTR+1,ST=$P(ZN,U,1),TOP=$P($G(^ONCO(165.5,PRI,2)),U,1)
.S SITE=$S(TOP'="":$P($G(^ONCO(164,TOP,0)),U,1),1:$P($G(^ONCO(164.2,ST,0)),U,1))
.S TSTAT=$P($G(^ONCO(165.5,PRI,7)),U,6)
.I CNTR#2=0 W !?3,SITE,": " I TSTAT'="" W $P($G(^ONCO(164.42,TSTAT,0)),U,1)
.I CNTR#2'=0 W ?70,SITE,": " I TSTAT'="" W $P($G(^ONCO(164.42,TSTAT,0)),U,1) D P Q:EX=U
.Q
W !
I $G(PRTPCE)=1 D PCEPRT^ONCOGEN
Q
FH ; Do the Follow-Up History display (#160,#400 multiple "F" node)
F FOLH=0:0 S FOLH=$O(^ONCO(160,PTIEN,"F","AA",FOLH)) Q:FOLH'>0!(EX=U) D
.S FHIEN=$O(^ONCO(160,PTIEN,"F","AA",FOLH,""))
.S FHZN=$G(^ONCO(160,PTIEN,"F",FHIEN,0)),FHDT=$P(FHZN,U,1) Q:FHDT=""!(EX=U)
.W !,"--------------------------------------------------------------------------------------------------------------------------------" D P Q:EX=U
.F OTHPRI=0:0 S OTHPRI=$O(^ONCO(165.5,"C",PTIEN,OTHPRI)) Q:OTHPRI'>0 I $$DIV^ONCFUNC(OTHPRI)=DUZ(2) D
..S PRZN=$G(^ONCO(165.5,OTHPRI,0)),DXDT=$P(PRZN,U,16)
..I DXDT=""!(DXDT>FHDT) Q
..S ST=$P(PRZN,U,1),TOP=$P($G(^ONCO(165.5,OTHPRI,2)),U,1)
..S SITE=$S(TOP'="":$P($G(^ONCO(164,TOP,0)),U,1),1:$P($G(^ONCO(164.2,ST,0)),U,1))
..S TSTAT="",TSDLC="",TSDLCFG="",TSIEN=$O(^ONCO(165.5,OTHPRI,"TS","B",FHDT,""))
..I TSIEN'="" S TSTAT=$P($G(^ONCO(165.5,OTHPRI,"TS",TSIEN,0)),U,2),TSDLC=$P($G(^ONCO(165.5,OTHPRI,"TS",TSIEN,0)),U,3),TSDLCFG=$P($G(^ONCO(165.5,OTHPRI,"TS",TSIEN,0)),U,4)
..W !?3,SITE,": " I TSTAT'="" W $P($G(^ONCO(164.42,TSTAT,0)),U,1) D P Q:EX=U D
...W !?3,"Date of Last Cancer Status : " I $G(TSDLC)'="" W $E(TSDLC,4,5)_"/"_$E(TSDLC,6,7)_"/"_($E(TSDLC,1,3)+1700)
...W !?3,"Date of Last Cancer Status Flag: ",$G(TSDLCFG)
...Q
..Q
.W !!," Last Contact: " S Y=FHDT D DD^%DT W Y
.W ?70," Follow-up Method: " S FM=$P(FHZN,U,4)
.W $S(FM=0:"Reported Hospitalization",FM=1:"Readmission (inpatient or outpatient)",FM=2:"Physician",FM=3:"Patient",FM=4:"Department of Motor Vehicles",FM=5:"Medicare/Medicaid file",FM=7:"Death certificate",FM=8:"Other",FM=9:"Unknown",1:"")
.D P Q:EX=U
.W !," Vital Status: " S VS=$P(FHZN,U,2) W $S(VS=0:"Dead",VS=1:"Alive",1:"")
.W ?70," Next Follow-up Method: " S NF=$P(FHZN,U,6)
.W $S(NF=0:"Chart requisition",NF=1:"Physician",NF=2:"Contact letter",NF=3:"Phone call",NF=4:"Other hospital contact",NF=5:"Other",NF=8:"Foreign residents (not allowed)",NF=9:"Not followed",1:"")
.D P Q:EX=U
.;W !," Quality of Survival: " S QS=$P(FHZN,U,5)
.;W $S(QS=0:"Normal",QS=1:"Symptomatic & Ambulatory",QS=2:"More than 50% Ambulatory",QS=3:"Less than 50% Ambulatory",QS=4:"Bedridden",QS=8:"Not applicable, dead",QS=9:"Unknown or unspecified",1:"")
.W ?70," Unusual Follow-up Method: " S UF=$P(FHZN,U,7) W $S(UF=0!(UF=1):"1st unusual method",UF=2:"2nd unusual method",1:"") D P Q:EX=U
.D P Q:EX=U
.W !?3,"Date Entered: " S DTE=$P(FHZN,U,11) I DTE'="" W $E(DTE,4,5)_"/"_$E(DTE,6,7)_"/"_($E(DTE,1,3)+1700)
.W ?72,"Registrar: " S REG=$P(FHZN,U,10) I REG'="" S REG1=$P($G(^VA(200,REG,0)),"^",1) W REG1
.D P Q:EX=U
.W !," Following Registry: " S FR=$P(FHZN,U,9) I FR'="" W $P($G(^ONCO(160.19,FR,0)),U,2)
.D P Q:EX=U
.I $D(^ONCO(160,PTIEN,"F",FHIEN,1,0)) D
..W !!," Comments:"
..F CMIEN=0:0 S CMIEN=$O(^ONCO(160,PTIEN,"F",FHIEN,1,CMIEN)) Q:CMIEN'>0 W !?5,$G(^ONCO(160,PTIEN,"F",FHIEN,1,CMIEN,0)) D P Q:EX=U
..Q
.Q
Q:EX=U W !,"--------------------------------------------------------------------------------------------------------------------------------"
Q
P ;
I ($Y'<(LINE-1)) D Q:EX=U W !
.I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR I 'Y S EX=U Q
.D HDR Q
Q
HDR ; Header
W @IOF S PG=PG+1
W CRA,!
W ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
Q
;
CLEANUP ;Cleanup
K CMIEN,CNTR,CRA,DTE,DXDT,EX,FHDT,FHIEN,FHZN,FM,FOLH,FR,IC,ICDCD,IEN
K LINE,NAME,NF,ONCAB,OTHPRI,PATH,PATNAME,PG,PRI,PRTPCE,PRZN,PTIEN
K REG,REG1,SITE,SSAN,ST,TITLE,TOP,TSIEN,TSTAT,UF,VS,Y,ZN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPA3A 5517 printed Apr 09, 2024@21:29:02 Page 2
ONCOPA3A ;Hines OIFO/RTK - [PA Print Complete Abstract (132c) ;03/11/11
+1 ;;2.2;ONCOLOGY;**1,12**;Jul 31, 2013;Build 8
+2 ;[PA Print Complete Abstract (132c)] continued
+3 SET NAME="FOLLOW-UP HISTORY"
DO FORMAT^ONCOPA1
+4 WRITE !!,TITLE,!
+5 IF $DATA(^ONCO(160,PTIEN,"F",0))
DO FH
if EX=U
QUIT
+6 WRITE !!," Date of Last Contact: ",ONCAB(165.5,IEN,200)
+7 WRITE ?50," Last Tumor Status: ",ONCAB(165.5,IEN,95)
DO P
if EX=U
QUIT
+8 WRITE !!," Date of Death: ",ONCAB(160,PTIEN,29)
DO P
if EX=U
QUIT
+9 WRITE !," Cause of Death/Cancer: ",ONCAB(160,PTIEN,18.9)
DO P
if EX=U
QUIT
+10 ;W !," ICD Cause of Death: ",ONCAB(160,PTIEN,19)," "
+11 ;S ICDCD=$P($G(^ONCO(160,PTIEN,1)),U,3) I ICDCD'="" S IC=$$ICDDX^ICDCODE(ICDCD) I +IC'=-1 W $P(IC,U,4) D P Q:EX=U
+12 ;W !," State Death Cert: ",$P($G(^ONCO(160,PTIEN,1)),U,14)," ",ONCAB(160,PTIEN,19.1) D P Q:EX=U
+13 ;W !," ICD Revision: ",ONCAB(160,PTIEN,20) D P Q:EX=U
+14 WRITE !," Place of Death: ",ONCAB(160,PTIEN,21)
DO P
if EX=U
QUIT
+15 WRITE !," Care Center at Death: ",ONCAB(160,PTIEN,24.5)
DO P
if EX=U
QUIT
+16 WRITE !," Autopsy: ",ONCAB(160,PTIEN,22.9)
DO P
if EX=U
QUIT
+17 WRITE !," Autopsy Date/Time: ",ONCAB(160,PTIEN,23)
DO P
if EX=U
QUIT
+18 WRITE !," Autopsy No.: ",ONCAB(160,PTIEN,24)
DO P
if EX=U
QUIT
+19 WRITE !," Path/Autopsy: "
FOR PATH=0:0
SET PATH=$ORDER(^ONCO(160,PTIEN,4,PATH))
if PATH'>0
QUIT
WRITE !?8,$GET(^ONCO(160,PTIEN,4,PATH,0))
DO P
if EX=U
QUIT
+20 IF $PIECE($GET(^ONCO(160,PTIEN,1)),U,1)=0
WRITE !!?30,"TUMOR Status at DEATH (Multiple Primaries)",!
SET CNTR=1
FOR PRI=0:0
SET PRI=$ORDER(^ONCO(165.5,"C",PTIEN,PRI))
if PRI'>0
QUIT
IF $$DIV^ONCFUNC(PRI)=DUZ(2)
Begin DoDot:1
+21 SET ZN=$GET(^ONCO(165.5,PRI,0))
if ZN=""
QUIT
+22 SET CNTR=CNTR+1
SET ST=$PIECE(ZN,U,1)
SET TOP=$PIECE($GET(^ONCO(165.5,PRI,2)),U,1)
+23 SET SITE=$SELECT(TOP'="":$PIECE($GET(^ONCO(164,TOP,0)),U,1),1:$PIECE($GET(^ONCO(164.2,ST,0)),U,1))
+24 SET TSTAT=$PIECE($GET(^ONCO(165.5,PRI,7)),U,6)
+25 IF CNTR#2=0
WRITE !?3,SITE,": "
IF TSTAT'=""
WRITE $PIECE($GET(^ONCO(164.42,TSTAT,0)),U,1)
+26 IF CNTR#2'=0
WRITE ?70,SITE,": "
IF TSTAT'=""
WRITE $PIECE($GET(^ONCO(164.42,TSTAT,0)),U,1)
DO P
if EX=U
QUIT
+27 QUIT
End DoDot:1
+28 WRITE !
+29 IF $GET(PRTPCE)=1
DO PCEPRT^ONCOGEN
+30 QUIT
FH ; Do the Follow-Up History display (#160,#400 multiple "F" node)
+1 FOR FOLH=0:0
SET FOLH=$ORDER(^ONCO(160,PTIEN,"F","AA",FOLH))
if FOLH'>0!(EX=U)
QUIT
Begin DoDot:1
+2 SET FHIEN=$ORDER(^ONCO(160,PTIEN,"F","AA",FOLH,""))
+3 SET FHZN=$GET(^ONCO(160,PTIEN,"F",FHIEN,0))
SET FHDT=$PIECE(FHZN,U,1)
if FHDT=""!(EX=U)
QUIT
+4 WRITE !,"--------------------------------------------------------------------------------------------------------------------------------"
DO P
if EX=U
QUIT
+5 FOR OTHPRI=0:0
SET OTHPRI=$ORDER(^ONCO(165.5,"C",PTIEN,OTHPRI))
if OTHPRI'>0
QUIT
IF $$DIV^ONCFUNC(OTHPRI)=DUZ(2)
Begin DoDot:2
+6 SET PRZN=$GET(^ONCO(165.5,OTHPRI,0))
SET DXDT=$PIECE(PRZN,U,16)
+7 IF DXDT=""!(DXDT>FHDT)
QUIT
+8 SET ST=$PIECE(PRZN,U,1)
SET TOP=$PIECE($GET(^ONCO(165.5,OTHPRI,2)),U,1)
+9 SET SITE=$SELECT(TOP'="":$PIECE($GET(^ONCO(164,TOP,0)),U,1),1:$PIECE($GET(^ONCO(164.2,ST,0)),U,1))
+10 SET TSTAT=""
SET TSDLC=""
SET TSDLCFG=""
SET TSIEN=$ORDER(^ONCO(165.5,OTHPRI,"TS","B",FHDT,""))
+11 IF TSIEN'=""
SET TSTAT=$PIECE($GET(^ONCO(165.5,OTHPRI,"TS",TSIEN,0)),U,2)
SET TSDLC=$PIECE($GET(^ONCO(165.5,OTHPRI,"TS",TSIEN,0)),U,3)
SET TSDLCFG=$PIECE($GET(^ONCO(165.5,OTHPRI,"TS",TSIEN,0)),U,4)
+12 WRITE !?3,SITE,": "
IF TSTAT'=""
WRITE $PIECE($GET(^ONCO(164.42,TSTAT,0)),U,1)
DO P
if EX=U
QUIT
Begin DoDot:3
+13 WRITE !?3,"Date of Last Cancer Status : "
IF $GET(TSDLC)'=""
WRITE $EXTRACT(TSDLC,4,5)_"/"_$EXTRACT(TSDLC,6,7)_"/"_($EXTRACT(TSDLC,1,3)+1700)
+14 WRITE !?3,"Date of Last Cancer Status Flag: ",$GET(TSDLCFG)
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 WRITE !!," Last Contact: "
SET Y=FHDT
DO DD^%DT
WRITE Y
+18 WRITE ?70," Follow-up Method: "
SET FM=$PIECE(FHZN,U,4)
+19 WRITE $SELECT(FM=0:"Reported Hospitalization",FM=1:"Readmission (inpatient or outpatient)",FM=2:"Physician",FM=3:"Patient",FM=4:"Department of Motor Vehicles",FM=5:"Medicare/Medicaid file",FM=7:"Death certificate",FM=8:"Other",FM=9:"Unk
nown",1:"")
+20 DO P
if EX=U
QUIT
+21 WRITE !," Vital Status: "
SET VS=$PIECE(FHZN,U,2)
WRITE $SELECT(VS=0:"Dead",VS=1:"Alive",1:"")
+22 WRITE ?70," Next Follow-up Method: "
SET NF=$PIECE(FHZN,U,6)
+23 WRITE $SELECT(NF=0:"Chart requisition",NF=1:"Physician",NF=2:"Contact letter",NF=3:"Phone call",NF=4:"Other hospital contact",NF=5:"Other",NF=8:"Foreign residents (not allowed)",NF=9:"Not followed",1:"")
+24 DO P
if EX=U
QUIT
+25 ;W !," Quality of Survival: " S QS=$P(FHZN,U,5)
+26 ;W $S(QS=0:"Normal",QS=1:"Symptomatic & Ambulatory",QS=2:"More than 50% Ambulatory",QS=3:"Less than 50% Ambulatory",QS=4:"Bedridden",QS=8:"Not applicable, dead",QS=9:"Unknown or unspecified",1:"")
+27 WRITE ?70," Unusual Follow-up Method: "
SET UF=$PIECE(FHZN,U,7)
WRITE $SELECT(UF=0!(UF=1):"1st unusual method",UF=2:"2nd unusual method",1:"")
DO P
if EX=U
QUIT
+28 DO P
if EX=U
QUIT
+29 WRITE !?3,"Date Entered: "
SET DTE=$PIECE(FHZN,U,11)
IF DTE'=""
WRITE $EXTRACT(DTE,4,5)_"/"_$EXTRACT(DTE,6,7)_"/"_($EXTRACT(DTE,1,3)+1700)
+30 WRITE ?72,"Registrar: "
SET REG=$PIECE(FHZN,U,10)
IF REG'=""
SET REG1=$PIECE($GET(^VA(200,REG,0)),"^",1)
WRITE REG1
+31 DO P
if EX=U
QUIT
+32 WRITE !," Following Registry: "
SET FR=$PIECE(FHZN,U,9)
IF FR'=""
WRITE $PIECE($GET(^ONCO(160.19,FR,0)),U,2)
+33 DO P
if EX=U
QUIT
+34 IF $DATA(^ONCO(160,PTIEN,"F",FHIEN,1,0))
Begin DoDot:2
+35 WRITE !!," Comments:"
+36 FOR CMIEN=0:0
SET CMIEN=$ORDER(^ONCO(160,PTIEN,"F",FHIEN,1,CMIEN))
if CMIEN'>0
QUIT
WRITE !?5,$GET(^ONCO(160,PTIEN,"F",FHIEN,1,CMIEN,0))
DO P
if EX=U
QUIT
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 if EX=U
QUIT
WRITE !,"--------------------------------------------------------------------------------------------------------------------------------"
+40 QUIT
P ;
+1 IF ($Y'<(LINE-1))
Begin DoDot:1
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue with this abstract"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+3 DO HDR
QUIT
End DoDot:1
if EX=U
QUIT
WRITE !
+4 QUIT
HDR ; Header
+1 WRITE @IOF
SET PG=PG+1
+2 WRITE CRA,!
+3 WRITE ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
+4 QUIT
+5 ;
CLEANUP ;Cleanup
+1 KILL CMIEN,CNTR,CRA,DTE,DXDT,EX,FHDT,FHIEN,FHZN,FM,FOLH,FR,IC,ICDCD,IEN
+2 KILL LINE,NAME,NF,ONCAB,OTHPRI,PATH,PATNAME,PG,PRI,PRTPCE,PRZN,PTIEN
+3 KILL REG,REG1,SITE,SSAN,ST,TITLE,TOP,TSIEN,TSTAT,UF,VS,Y,ZN
