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