ONCOAIF ;HINES OIFO/GWB - [PF Post/Edit Follow-up] ;11/08/10
;;2.2;ONCOLOGY;**1,4,5,6,17,18**;Jul 31, 2013;Build 5
;
BEG W @IOF,!," Post/Edit Follow-up"
W !," -------------------",!
Q
;
PAT ;[PF Post/Edit Follow-up]
N ONCDUZ,ONCDT
S ONCDUZ=DUZ,ONCDT=DT
D BEG
S DIC("A")=" Post/Edit Follow-Up for patient: "
S DIC="^ONCO(160,",DIC(0)="AEMQZ" D ^DIC K DIC
G KILL:Y<0
S (ONCOD0,DA,D0)=+Y,ONCONM=Y(0,0)
D SUM,LST^ONCODLF G DIE
;
LST ;Follow-Up
W @IOF,!!," **********FOLLOW-UP**********",!!
W " Patient: ",ONCONM
W:$D(XDD) !," Date of Inpatient Discharge: ",XDD
Q
;
EN ;FOLLOW-UP entry when patient has been pre-selected
K F,DIC,DO,ONCOD1,LC,VS,NF,XDT,XDD,XR
S ONCDUZ=DUZ,ONCDT=DT
S PRESEL=1
;S XDT=$S('$D(ONCOD0P):"",1:$$GET1^DIQ(165.5,ONCOD0P,1.1,"I"))
S XDT=""
I (XDT="")!(XDT="0000000")!(XDT="9999999") D LST G DIE
D DD S F=$P($G(^ONCO(160,ONCOD0,"F",0)),U,4)
I F<1 D DLC,LST S F=1 G DIE
RF S D0=ONCOD0 W !! K DXS,DIOT D BEG W ! D LST^ONCODLF G DIE
;
DIE K DXS
;P6.
K ^TMP("ONCFOL",160,$J)
M ^TMP("ONCFOL",160,$J,ONCOD0)=^ONCO(160,ONCOD0,"F")
S ONCDUZ=DUZ,ONCDT=DT
S ONCOSTAT=1,DA=ONCOD0,DR="[ONCO FOLLOWUP]",DIE="^ONCO(160,",FG=0
W ! D ^DIE
I 'FG S ONCOVS="" D UPOUT,CHKCMP I $G(FOLINP)="YES" G DIE
I $O(^ONCO(160,ONCOD0,"F",0))="" Q
; D CHKCHG
S XD0=ONCOD0 D DUPPRI^ONCFUNC
I 'FG D CHKCHG Q
;
UPDAT S D0=ONCOD0 K DXS,DIOT W ! D LST^ONCODLF,UPD^ONCOCRF
N Y,ONCOD,YSAVE
K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
D EN^DIQ1 W !
W !," Name..: ",ONC(160,ONCOD0,.01)
W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
W !," Status: ",ONC(160,ONCOD0,15)
W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
D SUM
C K DIR S DIR("A")="DATA OK",DIR("B")="Yes",DIR(0)="Y"
;D ^DIR Q:(Y=U)!(Y="") G DIE:'Y
D ^DIR S YSAVE=Y I (Y=U)!(Y="") D CHKCHG S Y=YSAVE Q ;Q:(Y=U)!(Y="") G DIE:'Y
G DIE:'Y
I ONCOVS G KILL:$G(ONCRFOPT)=1 S ONCFRMPF=1 G REC ;G KILL:$D(PRESEL) G PAT:'$D(REC),REC
W !! D DEAD^ONCOFDP
Q:$D(ONCOAI) G REC:$D(REC) D KILL K ONCONM S ONCOD=1 Q
;
UPOUT ;Up-arrow out check before deleting
Q:'$D(ONCOD1)
Q:'$D(^ONCO(160,ONCOD0,"F",ONCOD1,0))
Q:$P(^ONCO(160,ONCOD0,"F",ONCOD1,0),U,8)=1
D DEL
Q
;
DEL ;Delete FOLLOW-UP entry
S DA(1)=ONCOD0,DA=ONCOD1,DIK="^ONCO(160,"_DA(1)_",""F"","
D ^DIK S ONCOVS=""
W:$D(^ONCO(160,ONCOD0,"F",ONCOD1,0)) $P(^(0),U,8)
W !!," *********************ENTRY DELETED*************************"
W !!," You have not entered all of the required information."
W !!,"(Last Tumor Status(es) have been reset for this patient's primary site(s).)",!!
H 1
Q
;
CHKCMP ;Check for 'Complete" abstracts with no follow-up
N AN,ASTAT,PID,PN,PRIM,PSCODE,SEQ
Q:$O(^ONCO(160,ONCOD0,"F",0))'=""
S PRIM=0 F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
.I $P($G(^ONCO(165.5,PRIM,7)),U,2)=3 S ASTAT(PRIM)=""
Q:'$D(ASTAT)
W !
W !," There is no follow-up information for this patient."
W !," This patient has a 'Complete' abstract."
W !," A 'Complete' abstract requires at least one follow-up."
W !
K DIR
S DIR("A")=" Do you wish to enter a follow-up at this time"
S DIR("B")="YES",DIR(0)="Y" D ^DIR
I Y=1 S FOLINP="YES" Q
S FOLINP="NO"
S PRIM=0 F S PRIM=$O(ASTAT(PRIM)) Q:PRIM'>0 D
.S DIE="^ONCO(165.5,"
.S DA=PRIM
.S DR="91///0;197///@"
.D ^DIE
W !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)"
W !," for the following abstracts:",!
S PRIM=0 F S PRIM=$O(ASTAT(PRIM)) Q:PRIM'>0 D
.S PN=$$GET1^DIQ(165.5,PRIM,.02)
.S AN=$$GET1^DIQ(165.5,PRIM,.05)
.S SEQ=$$GET1^DIQ(165.5,PRIM,.06)
.S PID=$$GET1^DIQ(165.5,PRIM,61)
.S PSCODE=$$GET1^DIQ(165.5,PRIM,20.1)
.W !?1,PID," ",PSCODE," ",AN,"/",SEQ
.W !
K DIR S DIR(0)="E" D ^DIR
Q
;
CHKCHG ;Check for checksum and Follow-up changes to 'Complete' abstracts
N CHECKSUM,CNT,ONCDST,ONCDTTIM,ONCFF1,ONCFOL1,ERRFLG
D NOW^%DTC S ONCDTTIM=%
S (ONCFOL1,CNT)=0
F ONCFF1=0:0 S ONCFF1=$O(^ONCO(160,ONCOD0,"F",ONCFF1)) Q:(ONCFF1'>0)!(ONCFOL1=1) D
.W "."
.I $G(^ONCO(160,ONCOD0,"F",ONCFF1,0))'=$G(^TMP("ONCFOL",160,$J,ONCOD0,ONCFF1,0)) S ONCFOL1=1
;
W !!," Checking for changes to 'Complete' abstracts" S PRIM=0 F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
.W "."
.S DIE="^ONCO(165.5,",DA=PRIM,DR="198///^S X=ONCDTTIM" D ^DIE
.I ($P($G(^ONCO(165.5,PRIM,7)),U,2)=3),($G(ONCFOL1)) D
..W !,"Calling EDITs API..."
..S ERRFLG=0
..;S EDITS="NO"
..S (DA,D0)=PRIM D ^ONCGENED K EDITS
..;check for error
..I ERRFLG'=0 D Q
...W !!," EDITS errors were encountered."
...W !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)."
...S DIE="^ONCO(165.5,"
...S DR="91///0;197///@"
...D ^DIE
...W !
..S CNT=CNT+1
..S ONCDST=$NA(^TMP("ONC",$J))
..S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
..I CHECKSUM'=$P($G(^ONCO(165.5,PRIM,"EDITS")),U,1) D
...S $P(^ONCO(165.5,PRIM,"EDITS"),U,1)=CHECKSUM
...W !!," Re-computing checksum value for 'Complete' abstract ",$$GET1^DIQ(165.5,PRIM,.061)
W:CNT=0 " No changes found."
K ^TMP("ONC",$J)
K ^TMP("ONCFOL",160,$J)
Q
;
REC ;[RF Recurrence/Sub Tx Follow-up]
N D,ONCDUZ,ONCDT,TX
S ONCDUZ=DUZ,ONCDT=DT
S XR=1,REC="" W @IOF,!," Recurrence/Sub Tx Follow-up"
W !," ---------------------------",!
I $G(ONCFRMPF)=1 G RECPF ;if pt pre-selected from ^PF skip pt select
S ONCRFOPT=1,DIC("A")="Select Patient for Recurrence: "
S DIC="^ONCO(160,",DIC(0)="AEQMZ" D ^DIC K DIC
G KILL:Y<0
S (D0,ONCOD0)=+Y,ONCONM=Y(0,0)
N Y
RECPF K DIQ,ONC S DIC="^ONCO(160,",DR=".01;2;3;8;10;15",DA=ONCOD0,DIQ="ONC"
D EN^DIQ1 W !
W !?2,"Name.........: ",ONC(160,ONCOD0,.01)
W ?35,"Race.........: ",ONC(160,ONCOD0,8)
W !?2,"SSN..........: ",ONC(160,ONCOD0,2)
W ?35,"Sex..........: ",ONC(160,ONCOD0,10)
W !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
W ?35,"Status.......: ",ONC(160,ONCOD0,15)
D SUM
K DIC W !?1,"Select Primary for Recurrence: ",!
;S D="C",DIC="^ONCO(165.5,",X=ONCOD0,DIC(0)="EFZ" D IX^DIC G:Y<0 REC
;added Type of First Recurrence P *2.2*4
N ONC16012,ONC1655
S D="C",DIC="^ONCO(165.5,",X=ONCOD0,DIC(0)="EFZ"
S DIC("W")="S ONC16012=$P($G(^(5)),U,2),ONC1655=+Y D FST^ONCODSP"
D IX^DIC I Y<0 D CHKCHG,KILL Q ; G:Y<0 KILL
I Y'=" " S (ONCOD0P,DA)=+Y,DR="[ONCO RECURRENCE FOLLOWUP]",DIE="^ONCO(165.5,",DATEDX=$P(^ONCO(165.5,DA,0),U,16),TX=$P($G(^ONCO(165.5,DA,2)),U,1) D ^DIE D CHKCHG S AB=2,ONCOD0P=D0 G EN:$D(ONCRFOPT)
G KILL Q
;
RE ;Recurrence
W !!," Recurrence"," ----------"
; If Type of First Recurrence is not set yet, then check the
; Cancer Status field of Tumor Status multiple to set defaults for
; Type of First Rec, Rec Date 1st-Flag & Distant Sites 1-3 fields
; -- Called from [ONCO RECURRENCE FOLLOWUP] template --
S ONCTOFR=$P($G(^ONCO(165.5,ONCOD0P,5)),"^",2) I ONCTOFR'="" K ONCTOFR Q
S ONCTSDAT=$O(^ONCO(165.5,ONCOD0P,"TS","AA",0)) Q:ONCTSDAT=""
S ONCTSIEN=$O(^ONCO(165.5,ONCOD0P,"TS","AA",ONCTSDAT,0)) Q:ONCTSIEN=""
S ONCTSCS=$P($G(^ONCO(165.5,ONCOD0P,"TS",ONCTSIEN,0)),"^",2)
S ONCTOFRV=""
I ONCTSCS=1 S ONCTOFRV=$O(^ONCO(160.12,"B","00","")),ONCRD1F=11
I ONCTSCS=2 S ONCTOFRV=$O(^ONCO(160.12,"B",70,"")),ONCRD1F=11
I ONCTSCS=9 S ONCTOFRV=$O(^ONCO(160.12,"B",99,"")),ONCRD1F=10
;Hard set the nodes since we are within an Input Template when called
;so ^DIE not working - there are no X-refs to set
S $P(^ONCO(165.5,ONCOD0P,5),U,3,5)="0^0^0"
S $P(^ONCO(165.5,ONCOD0P,27),U,26)=ONCRD1F
;
K ONCRD1F,ONCTOFR,ONCTOFRV,ONCTSDAT,ONCTSIEN,ONCTSCS Q
;
STX ;Subsequent Course of Treatment
W !!," Subsequent Course of Treatment"
W !," ------------------------------"
Q
;
KILL ;Kill variables
K ONCOSTAT,XR,DA,DIC,DIE,DIK,DIOT,DIR,DO,DR,DXS,F,FG,FOLINP
K ONCOD1,ONCOLC,X,XD1,XD0,LC,ONCOVS,REC,YSAVE
K AB,DATEDX,PRESEL,ONCFRMPF,ONCRFOPT
K ^TMP("ONCFOL",160)
Q
;
DD ;Date format
S XDD=$E(XDT,4,5)_"/"_$E(XDT,6,7)_"/"_($E(XDT,1,3)+1700) Q
;
DLC ;Create FOLLOW-UP
K DA
S DA(1)=ONCOD0,DIC="^ONCO(160,"_DA(1)_","_"""F"""_","
S DLAYGO=160,X=XDT,DIC(0)="ZL"
I '$D(^ONCO(160,DA(1),"F")) S ^ONCO(160,DA(1),"F",0)="^160.04DAI^^"
D FILE^DICN S ONCOLC=XDT,DIE=DIC,DR="1////1;2////2;" D ^DIE
K DA,DIC,DLAYGO,DIE
Q
;
SUM ;Primary summary
S XD0=D0
N J,XD1 W !!
S J=0,XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $D(^ONCO(165.5,XD1,0)) S J=J+1 D ^ONCOCOML
Q
;
CLEANUP ;Cleanup
K D0,ONCOAI,ONCOD0,ONCOD0P
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAIF 8437 printed Nov 22, 2024@17:34:13 Page 2
ONCOAIF ;HINES OIFO/GWB - [PF Post/Edit Follow-up] ;11/08/10
+1 ;;2.2;ONCOLOGY;**1,4,5,6,17,18**;Jul 31, 2013;Build 5
+2 ;
BEG WRITE @IOF,!," Post/Edit Follow-up"
+1 WRITE !," -------------------",!
+2 QUIT
+3 ;
PAT ;[PF Post/Edit Follow-up]
+1 NEW ONCDUZ,ONCDT
+2 SET ONCDUZ=DUZ
SET ONCDT=DT
+3 DO BEG
+4 SET DIC("A")=" Post/Edit Follow-Up for patient: "
+5 SET DIC="^ONCO(160,"
SET DIC(0)="AEMQZ"
DO ^DIC
KILL DIC
+6 if Y<0
GOTO KILL
+7 SET (ONCOD0,DA,D0)=+Y
SET ONCONM=Y(0,0)
+8 DO SUM
DO LST^ONCODLF
GOTO DIE
+9 ;
LST ;Follow-Up
+1 WRITE @IOF,!!," **********FOLLOW-UP**********",!!
+2 WRITE " Patient: ",ONCONM
+3 if $DATA(XDD)
WRITE !," Date of Inpatient Discharge: ",XDD
+4 QUIT
+5 ;
EN ;FOLLOW-UP entry when patient has been pre-selected
+1 KILL F,DIC,DO,ONCOD1,LC,VS,NF,XDT,XDD,XR
+2 SET ONCDUZ=DUZ
SET ONCDT=DT
+3 SET PRESEL=1
+4 ;S XDT=$S('$D(ONCOD0P):"",1:$$GET1^DIQ(165.5,ONCOD0P,1.1,"I"))
+5 SET XDT=""
+6 IF (XDT="")!(XDT="0000000")!(XDT="9999999")
DO LST
GOTO DIE
+7 DO DD
SET F=$PIECE($GET(^ONCO(160,ONCOD0,"F",0)),U,4)
+8 IF F<1
DO DLC
DO LST
SET F=1
GOTO DIE
RF SET D0=ONCOD0
WRITE !!
KILL DXS,DIOT
DO BEG
WRITE !
DO LST^ONCODLF
GOTO DIE
+1 ;
DIE KILL DXS
+1 ;P6.
+2 KILL ^TMP("ONCFOL",160,$JOB)
+3 MERGE ^TMP("ONCFOL",160,$JOB,ONCOD0)=^ONCO(160,ONCOD0,"F")
+4 SET ONCDUZ=DUZ
SET ONCDT=DT
+5 SET ONCOSTAT=1
SET DA=ONCOD0
SET DR="[ONCO FOLLOWUP]"
SET DIE="^ONCO(160,"
SET FG=0
+6 WRITE !
DO ^DIE
+7 IF 'FG
SET ONCOVS=""
DO UPOUT
DO CHKCMP
IF $GET(FOLINP)="YES"
GOTO DIE
+8 IF $ORDER(^ONCO(160,ONCOD0,"F",0))=""
QUIT
+9 ; D CHKCHG
+10 SET XD0=ONCOD0
DO DUPPRI^ONCFUNC
+11 IF 'FG
DO CHKCHG
QUIT
+12 ;
UPDAT SET D0=ONCOD0
KILL DXS,DIOT
WRITE !
DO LST^ONCODLF
DO UPD^ONCOCRF
+1 NEW Y,ONCOD,YSAVE
+2 KILL DIQ,ONC
SET DIC="^ONCO(160,"
SET DR=".01;16;15;15.2"
SET DA=ONCOD0
SET DIQ="ONC"
+3 DO EN^DIQ1
WRITE !
+4 WRITE !," Name..: ",ONC(160,ONCOD0,.01)
+5 WRITE ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
+6 WRITE !," Status: ",ONC(160,ONCOD0,15)
+7 WRITE ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
+8 DO SUM
C KILL DIR
SET DIR("A")="DATA OK"
SET DIR("B")="Yes"
SET DIR(0)="Y"
+1 ;D ^DIR Q:(Y=U)!(Y="") G DIE:'Y
+2 ;Q:(Y=U)!(Y="") G DIE:'Y
DO ^DIR
SET YSAVE=Y
IF (Y=U)!(Y="")
DO CHKCHG
SET Y=YSAVE
QUIT
+3 if 'Y
GOTO DIE
+4 ;G KILL:$D(PRESEL) G PAT:'$D(REC),REC
IF ONCOVS
if $GET(ONCRFOPT)=1
GOTO KILL
SET ONCFRMPF=1
GOTO REC
+5 WRITE !!
DO DEAD^ONCOFDP
+6 if $DATA(ONCOAI)
QUIT
if $DATA(REC)
GOTO REC
DO KILL
KILL ONCONM
SET ONCOD=1
QUIT
+7 ;
UPOUT ;Up-arrow out check before deleting
+1 if '$DATA(ONCOD1)
QUIT
+2 if '$DATA(^ONCO(160,ONCOD0,"F",ONCOD1,0))
QUIT
+3 if $PIECE(^ONCO(160,ONCOD0,"F",ONCOD1,0),U,8)=1
QUIT
+4 DO DEL
+5 QUIT
+6 ;
DEL ;Delete FOLLOW-UP entry
+1 SET DA(1)=ONCOD0
SET DA=ONCOD1
SET DIK="^ONCO(160,"_DA(1)_",""F"","
+2 DO ^DIK
SET ONCOVS=""
+3 if $DATA(^ONCO(160,ONCOD0,"F",ONCOD1,0))
WRITE $PIECE(^(0),U,8)
+4 WRITE !!," *********************ENTRY DELETED*************************"
+5 WRITE !!," You have not entered all of the required information."
+6 WRITE !!,"(Last Tumor Status(es) have been reset for this patient's primary site(s).)",!!
+7 HANG 1
+8 QUIT
+9 ;
CHKCMP ;Check for 'Complete" abstracts with no follow-up
+1 NEW AN,ASTAT,PID,PN,PRIM,PSCODE,SEQ
+2 if $ORDER(^ONCO(160,ONCOD0,"F",0))'=""
QUIT
+3 SET PRIM=0
FOR
SET PRIM=$ORDER(^ONCO(165.5,"C",ONCOD0,PRIM))
if PRIM'>0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^ONCO(165.5,PRIM,7)),U,2)=3
SET ASTAT(PRIM)=""
End DoDot:1
+5 if '$DATA(ASTAT)
QUIT
+6 WRITE !
+7 WRITE !," There is no follow-up information for this patient."
+8 WRITE !," This patient has a 'Complete' abstract."
+9 WRITE !," A 'Complete' abstract requires at least one follow-up."
+10 WRITE !
+11 KILL DIR
+12 SET DIR("A")=" Do you wish to enter a follow-up at this time"
+13 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
+14 IF Y=1
SET FOLINP="YES"
QUIT
+15 SET FOLINP="NO"
+16 SET PRIM=0
FOR
SET PRIM=$ORDER(ASTAT(PRIM))
if PRIM'>0
QUIT
Begin DoDot:1
+17 SET DIE="^ONCO(165.5,"
+18 SET DA=PRIM
+19 SET DR="91///0;197///@"
+20 DO ^DIE
End DoDot:1
+21 WRITE !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)"
+22 WRITE !," for the following abstracts:",!
+23 SET PRIM=0
FOR
SET PRIM=$ORDER(ASTAT(PRIM))
if PRIM'>0
QUIT
Begin DoDot:1
+24 SET PN=$$GET1^DIQ(165.5,PRIM,.02)
+25 SET AN=$$GET1^DIQ(165.5,PRIM,.05)
+26 SET SEQ=$$GET1^DIQ(165.5,PRIM,.06)
+27 SET PID=$$GET1^DIQ(165.5,PRIM,61)
+28 SET PSCODE=$$GET1^DIQ(165.5,PRIM,20.1)
+29 WRITE !?1,PID," ",PSCODE," ",AN,"/",SEQ
+30 WRITE !
End DoDot:1
+31 KILL DIR
SET DIR(0)="E"
DO ^DIR
+32 QUIT
+33 ;
CHKCHG ;Check for checksum and Follow-up changes to 'Complete' abstracts
+1 NEW CHECKSUM,CNT,ONCDST,ONCDTTIM,ONCFF1,ONCFOL1,ERRFLG
+2 DO NOW^%DTC
SET ONCDTTIM=%
+3 SET (ONCFOL1,CNT)=0
+4 FOR ONCFF1=0:0
SET ONCFF1=$ORDER(^ONCO(160,ONCOD0,"F",ONCFF1))
if (ONCFF1'>0)!(ONCFOL1=1)
QUIT
Begin DoDot:1
+5 WRITE "."
+6 IF $GET(^ONCO(160,ONCOD0,"F",ONCFF1,0))'=$GET(^TMP("ONCFOL",160,$JOB,ONCOD0,ONCFF1,0))
SET ONCFOL1=1
End DoDot:1
+7 ;
+8 WRITE !!," Checking for changes to 'Complete' abstracts"
SET PRIM=0
FOR
SET PRIM=$ORDER(^ONCO(165.5,"C",ONCOD0,PRIM))
if PRIM'>0
QUIT
Begin DoDot:1
+9 WRITE "."
+10 SET DIE="^ONCO(165.5,"
SET DA=PRIM
SET DR="198///^S X=ONCDTTIM"
DO ^DIE
+11 IF ($PIECE($GET(^ONCO(165.5,PRIM,7)),U,2)=3)
IF ($GET(ONCFOL1))
Begin DoDot:2
+12 WRITE !,"Calling EDITs API..."
+13 SET ERRFLG=0
+14 ;S EDITS="NO"
+15 SET (DA,D0)=PRIM
DO ^ONCGENED
KILL EDITS
+16 ;check for error
+17 IF ERRFLG'=0
Begin DoDot:3
+18 WRITE !!," EDITS errors were encountered."
+19 WRITE !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)."
+20 SET DIE="^ONCO(165.5,"
+21 SET DR="91///0;197///@"
+22 DO ^DIE
+23 WRITE !
End DoDot:3
QUIT
+24 SET CNT=CNT+1
+25 SET ONCDST=$NAME(^TMP("ONC",$JOB))
+26 SET CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+27 IF CHECKSUM'=$PIECE($GET(^ONCO(165.5,PRIM,"EDITS")),U,1)
Begin DoDot:3
+28 SET $PIECE(^ONCO(165.5,PRIM,"EDITS"),U,1)=CHECKSUM
+29 WRITE !!," Re-computing checksum value for 'Complete' abstract ",$$GET1^DIQ(165.5,PRIM,.061)
End DoDot:3
End DoDot:2
End DoDot:1
+30 if CNT=0
WRITE " No changes found."
+31 KILL ^TMP("ONC",$JOB)
+32 KILL ^TMP("ONCFOL",160,$JOB)
+33 QUIT
+34 ;
REC ;[RF Recurrence/Sub Tx Follow-up]
+1 NEW D,ONCDUZ,ONCDT,TX
+2 SET ONCDUZ=DUZ
SET ONCDT=DT
+3 SET XR=1
SET REC=""
WRITE @IOF,!," Recurrence/Sub Tx Follow-up"
+4 WRITE !," ---------------------------",!
+5 ;if pt pre-selected from ^PF skip pt select
IF $GET(ONCFRMPF)=1
GOTO RECPF
+6 SET ONCRFOPT=1
SET DIC("A")="Select Patient for Recurrence: "
+7 SET DIC="^ONCO(160,"
SET DIC(0)="AEQMZ"
DO ^DIC
KILL DIC
+8 if Y<0
GOTO KILL
+9 SET (D0,ONCOD0)=+Y
SET ONCONM=Y(0,0)
+10 NEW Y
RECPF KILL DIQ,ONC
SET DIC="^ONCO(160,"
SET DR=".01;2;3;8;10;15"
SET DA=ONCOD0
SET DIQ="ONC"
+1 DO EN^DIQ1
WRITE !
+2 WRITE !?2,"Name.........: ",ONC(160,ONCOD0,.01)
+3 WRITE ?35,"Race.........: ",ONC(160,ONCOD0,8)
+4 WRITE !?2,"SSN..........: ",ONC(160,ONCOD0,2)
+5 WRITE ?35,"Sex..........: ",ONC(160,ONCOD0,10)
+6 WRITE !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
+7 WRITE ?35,"Status.......: ",ONC(160,ONCOD0,15)
+8 DO SUM
+9 KILL DIC
WRITE !?1,"Select Primary for Recurrence: ",!
+10 ;S D="C",DIC="^ONCO(165.5,",X=ONCOD0,DIC(0)="EFZ" D IX^DIC G:Y<0 REC
+11 ;added Type of First Recurrence P *2.2*4
+12 NEW ONC16012,ONC1655
+13 SET D="C"
SET DIC="^ONCO(165.5,"
SET X=ONCOD0
SET DIC(0)="EFZ"
+14 SET DIC("W")="S ONC16012=$P($G(^(5)),U,2),ONC1655=+Y D FST^ONCODSP"
+15 ; G:Y<0 KILL
DO IX^DIC
IF Y<0
DO CHKCHG
DO KILL
QUIT
+16 IF Y'=" "
SET (ONCOD0P,DA)=+Y
SET DR="[ONCO RECURRENCE FOLLOWUP]"
SET DIE="^ONCO(165.5,"
SET DATEDX=$PIECE(^ONCO(165.5,DA,0),U,16)
SET TX=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
DO ^DIE
DO CHKCHG
SET AB=2
SET ONCOD0P=D0
if $DATA(ONCRFOPT)
GOTO EN
+17 GOTO KILL
QUIT
+18 ;
RE ;Recurrence
+1 WRITE !!," Recurrence"," ----------"
+2 ; If Type of First Recurrence is not set yet, then check the
+3 ; Cancer Status field of Tumor Status multiple to set defaults for
+4 ; Type of First Rec, Rec Date 1st-Flag & Distant Sites 1-3 fields
+5 ; -- Called from [ONCO RECURRENCE FOLLOWUP] template --
+6 SET ONCTOFR=$PIECE($GET(^ONCO(165.5,ONCOD0P,5)),"^",2)
IF ONCTOFR'=""
KILL ONCTOFR
QUIT
+7 SET ONCTSDAT=$ORDER(^ONCO(165.5,ONCOD0P,"TS","AA",0))
if ONCTSDAT=""
QUIT
+8 SET ONCTSIEN=$ORDER(^ONCO(165.5,ONCOD0P,"TS","AA",ONCTSDAT,0))
if ONCTSIEN=""
QUIT
+9 SET ONCTSCS=$PIECE($GET(^ONCO(165.5,ONCOD0P,"TS",ONCTSIEN,0)),"^",2)
+10 SET ONCTOFRV=""
+11 IF ONCTSCS=1
SET ONCTOFRV=$ORDER(^ONCO(160.12,"B","00",""))
SET ONCRD1F=11
+12 IF ONCTSCS=2
SET ONCTOFRV=$ORDER(^ONCO(160.12,"B",70,""))
SET ONCRD1F=11
+13 IF ONCTSCS=9
SET ONCTOFRV=$ORDER(^ONCO(160.12,"B",99,""))
SET ONCRD1F=10
+14 ;Hard set the nodes since we are within an Input Template when called
+15 ;so ^DIE not working - there are no X-refs to set
+16 SET $PIECE(^ONCO(165.5,ONCOD0P,5),U,3,5)="0^0^0"
+17 SET $PIECE(^ONCO(165.5,ONCOD0P,27),U,26)=ONCRD1F
+18 ;
+19 KILL ONCRD1F,ONCTOFR,ONCTOFRV,ONCTSDAT,ONCTSIEN,ONCTSCS
QUIT
+20 ;
STX ;Subsequent Course of Treatment
+1 WRITE !!," Subsequent Course of Treatment"
+2 WRITE !," ------------------------------"
+3 QUIT
+4 ;
KILL ;Kill variables
+1 KILL ONCOSTAT,XR,DA,DIC,DIE,DIK,DIOT,DIR,DO,DR,DXS,F,FG,FOLINP
+2 KILL ONCOD1,ONCOLC,X,XD1,XD0,LC,ONCOVS,REC,YSAVE
+3 KILL AB,DATEDX,PRESEL,ONCFRMPF,ONCRFOPT
+4 KILL ^TMP("ONCFOL",160)
+5 QUIT
+6 ;
DD ;Date format
+1 SET XDD=$EXTRACT(XDT,4,5)_"/"_$EXTRACT(XDT,6,7)_"/"_($EXTRACT(XDT,1,3)+1700)
QUIT
+2 ;
DLC ;Create FOLLOW-UP
+1 KILL DA
+2 SET DA(1)=ONCOD0
SET DIC="^ONCO(160,"_DA(1)_","_"""F"""_","
+3 SET DLAYGO=160
SET X=XDT
SET DIC(0)="ZL"
+4 IF '$DATA(^ONCO(160,DA(1),"F"))
SET ^ONCO(160,DA(1),"F",0)="^160.04DAI^^"
+5 DO FILE^DICN
SET ONCOLC=XDT
SET DIE=DIC
SET DR="1////1;2////2;"
DO ^DIE
+6 KILL DA,DIC,DLAYGO,DIE
+7 QUIT
+8 ;
SUM ;Primary summary
+1 SET XD0=D0
+2 NEW J,XD1
WRITE !!
+3 SET J=0
SET XD1=0
FOR
SET XD1=$ORDER(^ONCO(165.5,"C",XD0,XD1))
if XD1'>0
QUIT
IF $DATA(^ONCO(165.5,XD1,0))
SET J=J+1
DO ^ONCOCOML
+4 QUIT
+5 ;
CLEANUP ;Cleanup
+1 KILL D0,ONCOAI,ONCOD0,ONCOD0P
