ONCOAIP ;HINES OIFO/GWB - [EE Abstract Edit Primary] ;09/26/11
;;2.2;ONCOLOGY;**1,4,5,6,10,15,16**;Jul 31, 2013;Build 5
;P16 remove recalculation of abstract
ED ;[EE Abstract Edit Primary]
N ONCDC8
W @IOF,!
S DIC="^ONCO(165.5,",DIC(0)="AEQZM"
S DIC("A")=" Select primary or patient name: "
D ^DIC K DIC G EX:Y<0
S ONCOD0P=+Y
S ONCOD0=$P(^ONCO(165.5,+Y,0),U,2)
S ONCONM=$$GET1^DIQ(160,ONCOD0,.01,"E")
S ONCOEDIT=1
;
EN N CHECKVER
S ONCOYR=($$TNMED^ONCOU55(ONCOD0P)>3)
S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
S CHECKSUM=$P($G(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)
S CHECKVER=$P($G(^ONCO(165.5,ONCOD0P,"EDITS")),U,2)
I ABSTAT=3,((CHECKSUM="")!(CHECKVER<12)) D
.W !,"Recalculating checksum..."
.S EDITS="NO" S D0=ONCOD0P D NAACCR^ONCGENED K EDITS
.S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
.S $P(^ONCO(165.5,ONCOD0P,"EDITS"),U,1)=CHECKSUM
.S $P(^ONCO(165.5,ONCOD0P,"EDITS"),U,2)=EXTVER
S DIE="^ONCO(165.5,",DA=ONCOD0P,DR="[ONCO ABSTRACT-I]",ONCOL1=0
L +^ONCO(165.5,DA):0 I $T D ^DIE L -^ONCO(165.5,DA) S ONCOL1=1
I 'ONCOL1 W !!,"This primary is being edited by another user" H 3 Q:'$D(ONCOEDIT) K ONCOL1 G ED
;I $D(Y) G EN
I ABSTAT'=3 D
.S DIE="^ONCO(165.5,"
.S DA=ONCOD0P
.S DR="197///@"
.D ^DIE
;
I (ABSTAT=3),($G(ONCOL1)=0) D
.W !,"Recalculating checksum..."
.S EDITS="NO" S D0=ONCOD0P D CHANGE^ONCGENED K EDITS
.S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
.I CHECKSUM'=$P($G(^ONCO(165.5,ONCOD0P,"EDITS")),U,1) D
..W !,"You have made a change to a 'Complete' abstract.",!
..S $P(^ONCO(165.5,ONCOD0P,"EDITS"),U,1)=CHECKSUM
..N ONCDTTIM
..D NOW^%DTC S ONCDTTIM=%
..I $P($G(^ONCO(165.5,ONCOD0P,7)),U,1)="" S DIE="^ONCO(165.5,",DA=ONCOD0P,DR="90///^S X=ONCDTTIM" D ^DIE
..S DIE="^ONCO(165.5,",DA=ONCOD0P,DR="198///^S X=ONCDTTIM" D ^DIE
;I ABSTAT=3 D CHANGE^ONCGENED I $G(Y)="@0" G EN
D FOL^ONCOAI
K ONCOL1,LYMPHOMA,RFDEF,TFDEF,DFDEF
;
I $G(Y)="@0" G EN
I $D(ONCOOUT) Q
I $D(Y) Q:'$D(ONCOEDIT) G ED
Q
;
PAIR ;LATERALITY (165.5,28)
D TOPNAM
S DATEDX=$P($G(^ONCO(165.5,D0,0)),U,16)
Q:TOP=""
I TOP=67342,$P(^ONCO(165.5,D0,2),U,8)="" S $P(^ONCO(165.5,D0,2),U,8)=1 Q
S PO=$P($G(^ONCO(164,TOP,0)),U,7)
I PO="",$P(^ONCO(165.5,D0,2),U,8)="" S $P(^ONCO(165.5,D0,2),U,8)=0
I DATEDX<3040000,(TOP=67700)!(TOP=67710)!(TOP=67711)!(TOP=67712)!(TOP=67713)!(TOP=67714)!(TOP=67722)!(TOP=67723)!(TOP=67724)!(TOP=67725),$P(^ONCO(165.5,D0,2),U,8)="" S $P(^ONCO(165.5,D0,2),U,8)=0
K PO
;
;Stuff TEXT-PRIMARY SITE TITLE (165.5,100)
S TEXT=$P($G(^ONCO(164,TOP,0)),U,1)
S:$P($G(^ONCO(165.5,D0,8)),U,1)="" $P(^ONCO(165.5,D0,8),U,1)=TEXT
K TEXT
Q
;
HISTXT ;Stuff TEXT-HISTOLOGY TITLE (165.5,101)
S HSTI=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
S TEXT=HISTNAM
S:$P($G(^ONCO(165.5,D0,8)),U,2)="" $P(^ONCO(165.5,D0,8),U,2)=$E(TEXT,1,100)
K HSTI,TEXT
D:$P($G(^ONCO(165.5,D0,0)),U,16)>3031231 ^ONCCS2
Q
;
MEN ;Primary Menu Options
K DXS,ONCOOUT,DASHES,PATNAM,SITEGP,SSN
S $P(DASHES,"-",80)="-"
S NODE0=^ONCO(165.5,D0,0)
S S=$P(NODE0,U,1),SITEGP=$P(^ONCO(164.2,S,0),U,1)
S Y=$P(NODE0,U,2),C=$P(^DD(165.5,.02,0),U,2) D Y^DIQ S PATNAM=Y
S SAVED0=D0 S D0=$P(NODE0,U,2) D SSN^ONCOES S SSN=X,D0=SAVED0
S DATEDX=$P(NODE0,U,16)
D ^ONCPHC
S COC=$E($$GET1^DIQ(165.5,D0,.04),1,2)
S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
I OSP="" S OSP=$O(^ONCO(160.1,0))
S IIN=$P($G(^ONCO(160.1,OSP,1)),U,4)
S RH=$P($G(^ONCO(160.19,IIN,0)),U,2)
K OSP
D TOPNAM
W @IOF
W !,?1,PATNAM,?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
W !,?25,"Primary Menu Options",!,DASHES
W !?22,"1. Patient Identification"
W !?22,"2. Cancer Identification"
W !?22,"3. Stage of Disease at Diagnosis"
W !?22," Collaborative Staging (2004+ cases)"
W !?22,"4. First Course of Treatment"
W !?22,"5. Performance Measures"
W !?22,"6. Over-ride Flags"
W !?22,"7. Case Administration"
W !?22,"8. EDIT Modifiers"
W !?22,"9. User-Defined Fields"
W !!?22,"A All - Complete Abstract"
;
A K ONCOANS,X,Y
R !!?25,"Enter option: All//",X:DTIME
S:X="" (ONCOANS,X)="A"
G:X["?" HP
I X=U!'$T S Y="",ONCOOUT=U Q
I (X="A")!(X="ALL")!(X="all")!(X="All") S ONCOANS="A",Y=1 G Y
I X="CS",$P($G(^ONCO(165.5,D0,0)),U,16)>3039999 S ONCOANS=3,Y=292 G Y
S (ONCOANS,Y)=X I X<1!(X>9) W "??" G A
;
Y S Y="@"_Y
Q
;
HP W !!,?10,"Select 'A' for the complete abstract"
W !?10,"Select 1-9 for the desired subsection",!
G A
;
PAT ;Patient Identification
S SECTION="Patient Identification" D SECTION
K DXS,DIOT D PI^ONCPCI
Q
;
CAN S SECTION="Cancer Identification" D SECTION
D PAIR
K DXS,DIOT S D0=ONCOD0P D CI^ONCPCI
Q
;
EXT S SECTION="Stage of Disease at Diagnosis" D SECTION
S SY="@31"
S S=$P(^ONCO(165.5,D0,0),U,1)
S T=$P($G(^ONCO(165.5,D0,2)),U,1)
S H=$$HIST^ONCFUNC(D0)
I (S=35)!($$LEUKEMIA^ONCOAIP2(D0))!((S>64)&(S<71)) D G PSD
.I $P($G(^ONCO(165.5,D0,0)),U,16)>3111231,$E(T,3,4)=77,H=98233 Q
.;I H=97613,S=77 Q
.S N=$S($E(H,1,4)=9731:"999^10^9",1:"999^80^9") ;Plasmacytoma, NOS
.S N=$S(S=65:"999^99^9^99^99^9^9^9^9",1:N_"^99^99^9^9^9^7") ;Unk primary
.I (T=67422)&(L'=1)&(H'=91403) S $P(N,U,2)=99,$P(N,U,9)=9 ;Spleen
.I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2),U,9,17)=N
.I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 S $P(^ONCO(165.5,D0,2),U,9,13)=$P(N,"^",1,5)
.D NOSTAGE
.;S SY="@313" ;skip to Other Staging System (165.5,39)
.S SY=227,ONCSKP39=1 ;Patch 5 goto #227 then skip to 39
.;I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 S Y="@355" D METS8^ONCSCHMU,NONXX^ONCSCHMU,EODPR88^ONCSCHMU,EODRN88^ONCSCHMU,EODMT88^ONCSCHMU ;Patch 10 make calls to 2018 AJCC & EOD fields for 2018+ cases
.I S=65 W !?18,"====> UNKNOWN PRIMARY - No EOD/TNM coding <====" Q
.W !?18,"====> SYSTEMIC DISEASE - No EOD/TNM coding <===="
;
PSD K DXS,DIOT S D0=ONCOD0P D ^ONCPSD K DXS
S Y=SY
Q
;
NOSTAGE ;No staging
S $P(^ONCO(165.5,D0,2.1),U,20)=999 ;29.3 Tumor Size Summary
S $P(^ONCO(165.5,D0,2.1),U,21)=999 ;29.4 Tumor Size Clinical
S $P(^ONCO(165.5,D0,2.1),U,22)=999 ;29.5 Tumor Size Pathologic
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2),U,25)=88 ;37.1 CT
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2),U,26)=88 ;37.2 CN
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2),U,27)=88 ;37.3 CM
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2),U,20)=88 ;38 C Stage Group
S $P(^ONCO(165.5,D0,3),U,32)=13 ;19 Staged By(C)=ONC*2.2*6 ptr 165.7
S $P(^ONCO(165.5,D0,7),U,17)="N" ;69.4 Multimodality Therapy (P)
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2.1),U,1)=88 ;85 PT
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2.1),U,2)=88 ;86 PN
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2.1),U,3)=88 ;87 PM
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S $P(^ONCO(165.5,D0,2.1),U,4)=88 ;88 P Stage Group
S $P(^ONCO(165.5,D0,2.1),U,5)=13 ;89 Staged By(P)=ONC*2.2*6 ptr 165.7
S $P(^ONCO(165.5,D0,2),U,28)="NA" ;38.5 Stage Grouping-AJCC
S:$P($G(^ONCO(165.5,D0,7)),U,7)="" $P(^ONCO(165.5,D0,7),U,7)="0000000"
S:$P($G(^ONCO(165.5,D0,7)),U,14)="" $P(^ONCO(165.5,D0,7),U,14)="0000000"
Q
;
FST S SECTION="First Course of Treatment" D SECTION
Q
;
ORF S SECTION="Over-ride Flags" D SECTION
K DXS,DIOT D ^ONCORF
Q
;
NTX ;DATE OF NO TREATMENT (165.5,124)
;I '$D(NTDD) S Y="@425" Q
I '$D(NTDD) S Y=138.4 Q
K NTDD
W !!?5,"You have entered a DATE OF NO TREATMENT. All treatment fields"
W !?5,"will be stuffed with the appropriate value indicating no"
W !?5,"treatment.",!
K DIR S DIR("A")="Are you sure you want to do this",DIR("B")="No"
S DIR(0)="Y" D ^DIR
I (Y=0)!(Y="") D S Y=124 W ! Q
.S TXDT=$P(^ONCO(165.5,D0,2.1),U,11)_"N"
.K ^ONCO(165.5,"ATX",D0,TXDT)
.S $P(^ONCO(165.5,D0,2.1),U,11)=""
I Y[U S $P(^ONCO(165.5,D0,2.1),U,11)="",Y="@0" Q
S NTX="" D NTX^ONCNTX K NTX,ONCRK1ST
Q
;
RS ;RADIATION/SURGERY SEQUENCE (165.5,51.3)
Q:$P($G(^ONCO(165.5,D0,3)),U,7)'=""
S S=$E($$GET1^DIQ(165.5,D0,58.6,"E"),1,2)
S SATF=$E($$GET1^DIQ(165.5,D0,58.7,"E"),1,2)
S SCP=$P($G(^ONCO(165.5,D0,3.1)),U,31)
S SCPATF=$P($G(^ONCO(165.5,D0,3.1)),U,32)
S SOTH=$P($G(^ONCO(165.5,D0,3.1)),U,33)
S SOTHATF=$P($G(^ONCO(165.5,D0,3.1)),U,34)
S R=$$GET1^DIQ(165.5,D0,51.2,"I")
S RATF=$$GET1^DIQ(165.5,D0,51.4,"I")
I ((S="00")!(S=99)!(S=98)!(S=""))&((SATF="00")!(SATF=99)!(SATF=98)!(SATF=""))&((SCP=0)!(SCP="")!(SCP=9))&((SCPATF=0)!(SCPATF="")!(SCPATF=9))&((SOTH=0)!(SOTH=""))&((SOTHATF=0)!(SOTHATF="")) S SR=0
E S SR=1
I ((R=0)!(R=7)!(R=8)!(R=9)!(R=""))&((RATF=0)!(RATF=7)!(RATF=8)!(RATF=9)!(RATF="")) S R=0
E S R=1
I ($G(SR)&$G(R)) D K S,SATF,SCP,SCPATF,SOTH,SOTHATF,R,RATF,SR,SDT,SATFDT,SCPDT,SCPATFDT,SOTDT,SOTATFDT,RDT,RATFDT,RSSEQ,FSDT,FRDT
.S SDT=$P($G(^ONCO(165.5,D0,3)),U,1)
.S:SDT'="" RSSEQ("S",SDT)="S",RSSEQ(SDT)="S"
.S SATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,8)
.S:SATFDT'="" RSSEQ("S",SATFDT)="S",RSSEQ(SATFDT)="S"
.S SCPDT=$P($G(^ONCO(165.5,D0,3.1)),U,22)
.S:SCPDT'="" RSSEQ("S",SCPDT)="S",RSSEQ(SCPDT)="S"
.S SCPATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,23)
.S:SCPATFDT'="" RSSEQ("S",SCPATFDT)="S",RSSEQ(SCPATFDT)="S"
.S SOTDT=$P($G(^ONCO(165.5,D0,3.1)),U,24)
.S:SOTDT'="" RSSEQ("S",SOTDT)="S",RSSEQ(SOTDT)="S"
.S SOTATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,25)
.S:SOTATFDT'="" RSSEQ("S",SOTATFDT)="S",RSSEQ(SOTATFDT)="S"
.S RDT=$P($G(^ONCO(165.5,D0,3)),U,4)
.S:RDT'="" RSSEQ("R",RDT)="R",RSSEQ(RDT)="R"
.S RATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,13)
.S:RATFDT'="" RSSEQ("R",RATFDT)="R",RSSEQ(RATFDT)="R"
.S FSDT=$O(RSSEQ("S",0)),FRDT=$O(RSSEQ("R",0))
.I FSDT=FRDT Q
.S RSSEQ=$O(RSSEQ(0))
.I RSSEQ(RSSEQ)="R" S $P(^ONCO(165.5,D0,3),U,7)=2
.I RSSEQ(RSSEQ)="S" S $P(^ONCO(165.5,D0,3),U,7)=3
E D
.S $P(^ONCO(165.5,D0,3),U,7)=0
Q
;
AB ;Abstract Status
S SECTION="Case Administration" D SECTION
N DI,DIC,DR,DA,DIQ,ONC,ONCDTEMP
S DIC="^ONCO(165.5,"
S DR="90:92;198;199;155;157.1;236;244"
S DA=D0,DIQ="ONC" D EN^DIQ1
S X=ONC(165.5,D0,91) D UCASE^ONCPCI S ONC(165.5,D0,91)=X
S X=ONC(165.5,D0,157.1) D UCASE^ONCPCI S ONC(165.5,D0,157.1)=X
W !," Abstract Status.............: ",ONC(165.5,D0,91)
W !," Date Case Initiated.........: ",ONC(165.5,D0,236)
W !," Initiated By................: ",ONC(165.5,D0,244)
W !," Date of First Contact.......: ",ONC(165.5,D0,155)
W !," Date Case Completed.........: " S ONCDTEMP=$P($G(^ONCO(165.5,D0,7)),U,1) W $$FMTE^XLFDT(ONCDTEMP,"5P")
W !," Elapsed Days to Completion..: ",$$GET1^DIQ(165.5,D0,157,"E")
;W !," Elapsed Months to Completion: ",ONC(165.5,D0,157.1)
W !," Abstracted by...............: ",ONC(165.5,D0,92)
W !," Date Case Last Changed......: " S ONCDTEMP=$P($G(^ONCO(165.5,D0,7)),U,21) W $$FMTE^XLFDT(ONCDTEMP,"5P")
W !," Case Last Changed by........: ",ONC(165.5,D0,199)
W !,DASHES
Q
;
NAN ;NEW ACC #
K DIR S DIR(0)="N^:"_($E(DT,1,3)+1700),DIR("A")="YEAR of Accession Number: ",DIR("B")=($E(DT,1,3)+1700) W !! D ^DIR Q:(Y=U)!(Y="")
NA S YR=Y,MR=YR_"0001",XR=999999-((YR+1)_"0000"),NR=$O(^ONCO(165.5,"AF",XR))
I NR<(990002-MR) W !!?5,"SYSTEM appears out of numbers-looking for unassigned ones" G FND
I NR>(999999-MR) S NR=""
S AC=$S(NR="":YR_"0001",1:(1000000-NR)),SEQ="00"
Q
;
FND ;SEARCH for unused #s
S NR=YR_"0000",MR=(YR+1)_"0000"
NR S NR=NR+1 I NR<MR G:$D(^ONCO(165.5,"AA",NR)) NR S AC=NR,SEQ="00" Q
W !!?10,"OUT of ACCESSION Numbers for 19"_YR S Y=U
Q
;
TOPNAM ;PRIMARY SITE and PRIMARY SITE CODE for header
K SITTAB
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1),TOPCOD="",TOPNAM=""
I TOP'="" S TOPNAM=$P($G(^ONCO(164,TOP,0)),U,1),TOPCOD=$P($G(^ONCO(164,TOP,0)),U,2)
S SITTAB=79-$L(SITEGP),TOPTAB=79-$L(TOPNAM_" "_TOPCOD)
S NOS=TOPTAB-$L(PATNAM),NOS=NOS-1 K SPACES S $P(SPACES," ",NOS)=" "
Q
;
SECTION S HDL=$L(SECTION),TAB=(80-HDL)\2,TAB=TAB-1
W @IOF,DASHES
W !,?1,PATNAM,?TAB,SECTION,?SITTAB,SITEGP
W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
W !,DASHES
Q
;
EX ;Exit
D KILL^ONCOAI
K ABSTAT,AC,C,CHECKSUM,D0,DASHES,DATEDX,DIE,H,HDL,HISTNAM,HSTFLD,IIN
K L,MR,N,NODE0,NOS,NR,ONCDST,ONCOD0,ONCOD0P,ONCOEDIT,ONCONM,ONCOYR
K PATNAM,RH,SAVED0,SECTION,SEQ,SITEGP,SITTAB,SSN,SY,T,TAB
K TOP,TOPCOD,TOPNAM,TOPTAB,TXDT,X,XR,YR
Q
;
CLEANUP ;Cleanup
K COC,EXTVER
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAIP 12325 printed Apr 09, 2024@21:24:44 Page 2
ONCOAIP ;HINES OIFO/GWB - [EE Abstract Edit Primary] ;09/26/11
+1 ;;2.2;ONCOLOGY;**1,4,5,6,10,15,16**;Jul 31, 2013;Build 5
+2 ;P16 remove recalculation of abstract
ED ;[EE Abstract Edit Primary]
+1 NEW ONCDC8
+2 WRITE @IOF,!
+3 SET DIC="^ONCO(165.5,"
SET DIC(0)="AEQZM"
+4 SET DIC("A")=" Select primary or patient name: "
+5 DO ^DIC
KILL DIC
if Y<0
GOTO EX
+6 SET ONCOD0P=+Y
+7 SET ONCOD0=$PIECE(^ONCO(165.5,+Y,0),U,2)
+8 SET ONCONM=$$GET1^DIQ(160,ONCOD0,.01,"E")
+9 SET ONCOEDIT=1
+10 ;
EN NEW CHECKVER
+1 SET ONCOYR=($$TNMED^ONCOU55(ONCOD0P)>3)
+2 SET ABSTAT=$PIECE($GET(^ONCO(165.5,ONCOD0P,7)),U,2)
+3 SET CHECKSUM=$PIECE($GET(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)
+4 SET CHECKVER=$PIECE($GET(^ONCO(165.5,ONCOD0P,"EDITS")),U,2)
+5 IF ABSTAT=3
IF ((CHECKSUM="")!(CHECKVER<12))
Begin DoDot:1
+6 WRITE !,"Recalculating checksum..."
+7 SET EDITS="NO"
SET D0=ONCOD0P
DO NAACCR^ONCGENED
KILL EDITS
+8 SET CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+9 SET $PIECE(^ONCO(165.5,ONCOD0P,"EDITS"),U,1)=CHECKSUM
+10 SET $PIECE(^ONCO(165.5,ONCOD0P,"EDITS"),U,2)=EXTVER
End DoDot:1
+11 SET DIE="^ONCO(165.5,"
SET DA=ONCOD0P
SET DR="[ONCO ABSTRACT-I]"
SET ONCOL1=0
+12 LOCK +^ONCO(165.5,DA):0
IF $TEST
DO ^DIE
LOCK -^ONCO(165.5,DA)
SET ONCOL1=1
+13 IF 'ONCOL1
WRITE !!,"This primary is being edited by another user"
HANG 3
if '$DATA(ONCOEDIT)
QUIT
KILL ONCOL1
GOTO ED
+14 ;I $D(Y) G EN
+15 IF ABSTAT'=3
Begin DoDot:1
+16 SET DIE="^ONCO(165.5,"
+17 SET DA=ONCOD0P
+18 SET DR="197///@"
+19 DO ^DIE
End DoDot:1
+20 ;
+21 IF (ABSTAT=3)
IF ($GET(ONCOL1)=0)
Begin DoDot:1
+22 WRITE !,"Recalculating checksum..."
+23 SET EDITS="NO"
SET D0=ONCOD0P
DO CHANGE^ONCGENED
KILL EDITS
+24 SET CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+25 IF CHECKSUM'=$PIECE($GET(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)
Begin DoDot:2
+26 WRITE !,"You have made a change to a 'Complete' abstract.",!
+27 SET $PIECE(^ONCO(165.5,ONCOD0P,"EDITS"),U,1)=CHECKSUM
+28 NEW ONCDTTIM
+29 DO NOW^%DTC
SET ONCDTTIM=%
+30 IF $PIECE($GET(^ONCO(165.5,ONCOD0P,7)),U,1)=""
SET DIE="^ONCO(165.5,"
SET DA=ONCOD0P
SET DR="90///^S X=ONCDTTIM"
DO ^DIE
+31 SET DIE="^ONCO(165.5,"
SET DA=ONCOD0P
SET DR="198///^S X=ONCDTTIM"
DO ^DIE
End DoDot:2
End DoDot:1
+32 ;I ABSTAT=3 D CHANGE^ONCGENED I $G(Y)="@0" G EN
+33 DO FOL^ONCOAI
+34 KILL ONCOL1,LYMPHOMA,RFDEF,TFDEF,DFDEF
+35 ;
+36 IF $GET(Y)="@0"
GOTO EN
+37 IF $DATA(ONCOOUT)
QUIT
+38 IF $DATA(Y)
if '$DATA(ONCOEDIT)
QUIT
GOTO ED
+39 QUIT
+40 ;
PAIR ;LATERALITY (165.5,28)
+1 DO TOPNAM
+2 SET DATEDX=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
+3 if TOP=""
QUIT
+4 IF TOP=67342
IF $PIECE(^ONCO(165.5,D0,2),U,8)=""
SET $PIECE(^ONCO(165.5,D0,2),U,8)=1
QUIT
+5 SET PO=$PIECE($GET(^ONCO(164,TOP,0)),U,7)
+6 IF PO=""
IF $PIECE(^ONCO(165.5,D0,2),U,8)=""
SET $PIECE(^ONCO(165.5,D0,2),U,8)=0
+7 IF DATEDX<3040000
IF (TOP=67700)!(TOP=67710)!(TOP=67711)!(TOP=67712)!(TOP=67713)!(TOP=67714)!(TOP=67722)!(TOP=67723)!(TOP=67724)!(TOP=67725)
IF $PIECE(^ONCO(165.5,D0,2),U,8)=""
SET $PIECE(^ONCO(165.5,D0,2),U,8)=0
+8 KILL PO
+9 ;
+10 ;Stuff TEXT-PRIMARY SITE TITLE (165.5,100)
+11 SET TEXT=$PIECE($GET(^ONCO(164,TOP,0)),U,1)
+12 if $PIECE($GET(^ONCO(165.5,D0,8)),U,1)=""
SET $PIECE(^ONCO(165.5,D0,8),U,1)=TEXT
+13 KILL TEXT
+14 QUIT
+15 ;
HISTXT ;Stuff TEXT-HISTOLOGY TITLE (165.5,101)
+1 SET HSTI=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
+2 SET TEXT=HISTNAM
+3 if $PIECE($GET(^ONCO(165.5,D0,8)),U,2)=""
SET $PIECE(^ONCO(165.5,D0,8),U,2)=$EXTRACT(TEXT,1,100)
+4 KILL HSTI,TEXT
+5 if $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3031231
DO ^ONCCS2
+6 QUIT
+7 ;
MEN ;Primary Menu Options
+1 KILL DXS,ONCOOUT,DASHES,PATNAM,SITEGP,SSN
+2 SET $PIECE(DASHES,"-",80)="-"
+3 SET NODE0=^ONCO(165.5,D0,0)
+4 SET S=$PIECE(NODE0,U,1)
SET SITEGP=$PIECE(^ONCO(164.2,S,0),U,1)
+5 SET Y=$PIECE(NODE0,U,2)
SET C=$PIECE(^DD(165.5,.02,0),U,2)
DO Y^DIQ
SET PATNAM=Y
+6 SET SAVED0=D0
SET D0=$PIECE(NODE0,U,2)
DO SSN^ONCOES
SET SSN=X
SET D0=SAVED0
+7 SET DATEDX=$PIECE(NODE0,U,16)
+8 DO ^ONCPHC
+9 SET COC=$EXTRACT($$GET1^DIQ(165.5,D0,.04),1,2)
+10 SET OSP=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
+11 IF OSP=""
SET OSP=$ORDER(^ONCO(160.1,0))
+12 SET IIN=$PIECE($GET(^ONCO(160.1,OSP,1)),U,4)
+13 SET RH=$PIECE($GET(^ONCO(160.19,IIN,0)),U,2)
+14 KILL OSP
+15 DO TOPNAM
+16 WRITE @IOF
+17 WRITE !,?1,PATNAM,?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
+18 WRITE !,?25,"Primary Menu Options",!,DASHES
+19 WRITE !?22,"1. Patient Identification"
+20 WRITE !?22,"2. Cancer Identification"
+21 WRITE !?22,"3. Stage of Disease at Diagnosis"
+22 WRITE !?22," Collaborative Staging (2004+ cases)"
+23 WRITE !?22,"4. First Course of Treatment"
+24 WRITE !?22,"5. Performance Measures"
+25 WRITE !?22,"6. Over-ride Flags"
+26 WRITE !?22,"7. Case Administration"
+27 WRITE !?22,"8. EDIT Modifiers"
+28 WRITE !?22,"9. User-Defined Fields"
+29 WRITE !!?22,"A All - Complete Abstract"
+30 ;
A KILL ONCOANS,X,Y
+1 READ !!?25,"Enter option: All//",X:DTIME
+2 if X=""
SET (ONCOANS,X)="A"
+3 if X["?"
GOTO HP
+4 IF X=U!'$TEST
SET Y=""
SET ONCOOUT=U
QUIT
+5 IF (X="A")!(X="ALL")!(X="all")!(X="All")
SET ONCOANS="A"
SET Y=1
GOTO Y
+6 IF X="CS"
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3039999
SET ONCOANS=3
SET Y=292
GOTO Y
+7 SET (ONCOANS,Y)=X
IF X<1!(X>9)
WRITE "??"
GOTO A
+8 ;
Y SET Y="@"_Y
+1 QUIT
+2 ;
HP WRITE !!,?10,"Select 'A' for the complete abstract"
+1 WRITE !?10,"Select 1-9 for the desired subsection",!
+2 GOTO A
+3 ;
PAT ;Patient Identification
+1 SET SECTION="Patient Identification"
DO SECTION
+2 KILL DXS,DIOT
DO PI^ONCPCI
+3 QUIT
+4 ;
CAN SET SECTION="Cancer Identification"
DO SECTION
+1 DO PAIR
+2 KILL DXS,DIOT
SET D0=ONCOD0P
DO CI^ONCPCI
+3 QUIT
+4 ;
EXT SET SECTION="Stage of Disease at Diagnosis"
DO SECTION
+1 SET SY="@31"
+2 SET S=$PIECE(^ONCO(165.5,D0,0),U,1)
+3 SET T=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+4 SET H=$$HIST^ONCFUNC(D0)
+5 IF (S=35)!($$LEUKEMIA^ONCOAIP2(D0))!((S>64)&(S<71))
Begin DoDot:1
+6 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3111231
IF $EXTRACT(T,3,4)=77
IF H=98233
QUIT
+7 ;I H=97613,S=77 Q
+8 ;Plasmacytoma, NOS
SET N=$SELECT($EXTRACT(H,1,4)=9731:"999^10^9",1:"999^80^9")
+9 ;Unk primary
SET N=$SELECT(S=65:"999^99^9^99^99^9^9^9^9",1:N_"^99^99^9^9^9^7")
+10 ;Spleen
IF (T=67422)&(L'=1)&(H'=91403)
SET $PIECE(N,U,2)=99
SET $PIECE(N,U,9)=9
+11 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2),U,9,17)=N
+12 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
SET $PIECE(^ONCO(165.5,D0,2),U,9,13)=$PIECE(N,"^",1,5)
+13 DO NOSTAGE
+14 ;S SY="@313" ;skip to Other Staging System (165.5,39)
+15 ;Patch 5 goto #227 then skip to 39
SET SY=227
SET ONCSKP39=1
+16 ;I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 S Y="@355" D METS8^ONCSCHMU,NONXX^ONCSCHMU,EODPR88^ONCSCHMU,EODRN88^ONCSCHMU,EODMT88^ONCSCHMU ;Patch 10 make calls to 2018 AJCC & EOD fields for 2018+ cases
+17 IF S=65
WRITE !?18,"====> UNKNOWN PRIMARY - No EOD/TNM coding <===="
QUIT
+18 WRITE !?18,"====> SYSTEMIC DISEASE - No EOD/TNM coding <===="
End DoDot:1
GOTO PSD
+19 ;
PSD KILL DXS,DIOT
SET D0=ONCOD0P
DO ^ONCPSD
KILL DXS
+1 SET Y=SY
+2 QUIT
+3 ;
NOSTAGE ;No staging
+1 ;29.3 Tumor Size Summary
SET $PIECE(^ONCO(165.5,D0,2.1),U,20)=999
+2 ;29.4 Tumor Size Clinical
SET $PIECE(^ONCO(165.5,D0,2.1),U,21)=999
+3 ;29.5 Tumor Size Pathologic
SET $PIECE(^ONCO(165.5,D0,2.1),U,22)=999
+4 ;37.1 CT
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2),U,25)=88
+5 ;37.2 CN
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2),U,26)=88
+6 ;37.3 CM
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2),U,27)=88
+7 ;38 C Stage Group
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2),U,20)=88
+8 ;19 Staged By(C)=ONC*2.2*6 ptr 165.7
SET $PIECE(^ONCO(165.5,D0,3),U,32)=13
+9 ;69.4 Multimodality Therapy (P)
SET $PIECE(^ONCO(165.5,D0,7),U,17)="N"
+10 ;85 PT
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2.1),U,1)=88
+11 ;86 PN
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2.1),U,2)=88
+12 ;87 PM
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2.1),U,3)=88
+13 ;88 P Stage Group
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
SET $PIECE(^ONCO(165.5,D0,2.1),U,4)=88
+14 ;89 Staged By(P)=ONC*2.2*6 ptr 165.7
SET $PIECE(^ONCO(165.5,D0,2.1),U,5)=13
+15 ;38.5 Stage Grouping-AJCC
SET $PIECE(^ONCO(165.5,D0,2),U,28)="NA"
+16 if $PIECE($GET(^ONCO(165.5,D0,7)),U,7)=""
SET $PIECE(^ONCO(165.5,D0,7),U,7)="0000000"
+17 if $PIECE($GET(^ONCO(165.5,D0,7)),U,14)=""
SET $PIECE(^ONCO(165.5,D0,7),U,14)="0000000"
+18 QUIT
+19 ;
FST SET SECTION="First Course of Treatment"
DO SECTION
+1 QUIT
+2 ;
ORF SET SECTION="Over-ride Flags"
DO SECTION
+1 KILL DXS,DIOT
DO ^ONCORF
+2 QUIT
+3 ;
NTX ;DATE OF NO TREATMENT (165.5,124)
+1 ;I '$D(NTDD) S Y="@425" Q
+2 IF '$DATA(NTDD)
SET Y=138.4
QUIT
+3 KILL NTDD
+4 WRITE !!?5,"You have entered a DATE OF NO TREATMENT. All treatment fields"
+5 WRITE !?5,"will be stuffed with the appropriate value indicating no"
+6 WRITE !?5,"treatment.",!
+7 KILL DIR
SET DIR("A")="Are you sure you want to do this"
SET DIR("B")="No"
+8 SET DIR(0)="Y"
DO ^DIR
+9 IF (Y=0)!(Y="")
Begin DoDot:1
+10 SET TXDT=$PIECE(^ONCO(165.5,D0,2.1),U,11)_"N"
+11 KILL ^ONCO(165.5,"ATX",D0,TXDT)
+12 SET $PIECE(^ONCO(165.5,D0,2.1),U,11)=""
End DoDot:1
SET Y=124
WRITE !
QUIT
+13 IF Y[U
SET $PIECE(^ONCO(165.5,D0,2.1),U,11)=""
SET Y="@0"
QUIT
+14 SET NTX=""
DO NTX^ONCNTX
KILL NTX,ONCRK1ST
+15 QUIT
+16 ;
RS ;RADIATION/SURGERY SEQUENCE (165.5,51.3)
+1 if $PIECE($GET(^ONCO(165.5,D0,3)),U,7)'=""
QUIT
+2 SET S=$EXTRACT($$GET1^DIQ(165.5,D0,58.6,"E"),1,2)
+3 SET SATF=$EXTRACT($$GET1^DIQ(165.5,D0,58.7,"E"),1,2)
+4 SET SCP=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,31)
+5 SET SCPATF=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,32)
+6 SET SOTH=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,33)
+7 SET SOTHATF=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,34)
+8 SET R=$$GET1^DIQ(165.5,D0,51.2,"I")
+9 SET RATF=$$GET1^DIQ(165.5,D0,51.4,"I")
+10 IF ((S="00")!(S=99)!(S=98)!(S=""))&((SATF="00")!(SATF=99)!(SATF=98)!(SATF=""))&((SCP=0)!(SCP="")!(SCP=9))&((SCPATF=0)!(SCPATF="")!(SCPATF=9))&((SOTH=0)!(SOTH=""))&((SOTHATF=0)!(SOTHATF=""))
SET SR=0
+11 IF '$TEST
SET SR=1
+12 IF ((R=0)!(R=7)!(R=8)!(R=9)!(R=""))&((RATF=0)!(RATF=7)!(RATF=8)!(RATF=9)!(RATF=""))
SET R=0
+13 IF '$TEST
SET R=1
+14 IF ($GET(SR)&$GET(R))
Begin DoDot:1
+15 SET SDT=$PIECE($GET(^ONCO(165.5,D0,3)),U,1)
+16 if SDT'=""
SET RSSEQ("S",SDT)="S"
SET RSSEQ(SDT)="S"
+17 SET SATFDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,8)
+18 if SATFDT'=""
SET RSSEQ("S",SATFDT)="S"
SET RSSEQ(SATFDT)="S"
+19 SET SCPDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,22)
+20 if SCPDT'=""
SET RSSEQ("S",SCPDT)="S"
SET RSSEQ(SCPDT)="S"
+21 SET SCPATFDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,23)
+22 if SCPATFDT'=""
SET RSSEQ("S",SCPATFDT)="S"
SET RSSEQ(SCPATFDT)="S"
+23 SET SOTDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,24)
+24 if SOTDT'=""
SET RSSEQ("S",SOTDT)="S"
SET RSSEQ(SOTDT)="S"
+25 SET SOTATFDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,25)
+26 if SOTATFDT'=""
SET RSSEQ("S",SOTATFDT)="S"
SET RSSEQ(SOTATFDT)="S"
+27 SET RDT=$PIECE($GET(^ONCO(165.5,D0,3)),U,4)
+28 if RDT'=""
SET RSSEQ("R",RDT)="R"
SET RSSEQ(RDT)="R"
+29 SET RATFDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,13)
+30 if RATFDT'=""
SET RSSEQ("R",RATFDT)="R"
SET RSSEQ(RATFDT)="R"
+31 SET FSDT=$ORDER(RSSEQ("S",0))
SET FRDT=$ORDER(RSSEQ("R",0))
+32 IF FSDT=FRDT
QUIT
+33 SET RSSEQ=$ORDER(RSSEQ(0))
+34 IF RSSEQ(RSSEQ)="R"
SET $PIECE(^ONCO(165.5,D0,3),U,7)=2
+35 IF RSSEQ(RSSEQ)="S"
SET $PIECE(^ONCO(165.5,D0,3),U,7)=3
End DoDot:1
KILL S,SATF,SCP,SCPATF,SOTH,SOTHATF,R,RATF,SR,SDT,SATFDT,SCPDT,SCPATFDT,SOTDT,SOTATFDT,RDT,RATFDT,RSSEQ,FSDT,FRDT
+36 IF '$TEST
Begin DoDot:1
+37 SET $PIECE(^ONCO(165.5,D0,3),U,7)=0
End DoDot:1
+38 QUIT
+39 ;
AB ;Abstract Status
+1 SET SECTION="Case Administration"
DO SECTION
+2 NEW DI,DIC,DR,DA,DIQ,ONC,ONCDTEMP
+3 SET DIC="^ONCO(165.5,"
+4 SET DR="90:92;198;199;155;157.1;236;244"
+5 SET DA=D0
SET DIQ="ONC"
DO EN^DIQ1
+6 SET X=ONC(165.5,D0,91)
DO UCASE^ONCPCI
SET ONC(165.5,D0,91)=X
+7 SET X=ONC(165.5,D0,157.1)
DO UCASE^ONCPCI
SET ONC(165.5,D0,157.1)=X
+8 WRITE !," Abstract Status.............: ",ONC(165.5,D0,91)
+9 WRITE !," Date Case Initiated.........: ",ONC(165.5,D0,236)
+10 WRITE !," Initiated By................: ",ONC(165.5,D0,244)
+11 WRITE !," Date of First Contact.......: ",ONC(165.5,D0,155)
+12 WRITE !," Date Case Completed.........: "
SET ONCDTEMP=$PIECE($GET(^ONCO(165.5,D0,7)),U,1)
WRITE $$FMTE^XLFDT(ONCDTEMP,"5P")
+13 WRITE !," Elapsed Days to Completion..: ",$$GET1^DIQ(165.5,D0,157,"E")
+14 ;W !," Elapsed Months to Completion: ",ONC(165.5,D0,157.1)
+15 WRITE !," Abstracted by...............: ",ONC(165.5,D0,92)
+16 WRITE !," Date Case Last Changed......: "
SET ONCDTEMP=$PIECE($GET(^ONCO(165.5,D0,7)),U,21)
WRITE $$FMTE^XLFDT(ONCDTEMP,"5P")
+17 WRITE !," Case Last Changed by........: ",ONC(165.5,D0,199)
+18 WRITE !,DASHES
+19 QUIT
+20 ;
NAN ;NEW ACC #
+1 KILL DIR
SET DIR(0)="N^:"_($EXTRACT(DT,1,3)+1700)
SET DIR("A")="YEAR of Accession Number: "
SET DIR("B")=($EXTRACT(DT,1,3)+1700)
WRITE !!
DO ^DIR
if (Y=U)!(Y="")
QUIT
NA SET YR=Y
SET MR=YR_"0001"
SET XR=999999-((YR+1)_"0000")
SET NR=$ORDER(^ONCO(165.5,"AF",XR))
+1 IF NR<(990002-MR)
WRITE !!?5,"SYSTEM appears out of numbers-looking for unassigned ones"
GOTO FND
+2 IF NR>(999999-MR)
SET NR=""
+3 SET AC=$SELECT(NR="":YR_"0001",1:(1000000-NR))
SET SEQ="00"
+4 QUIT
+5 ;
FND ;SEARCH for unused #s
+1 SET NR=YR_"0000"
SET MR=(YR+1)_"0000"
NR SET NR=NR+1
IF NR<MR
if $DATA(^ONCO(165.5,"AA",NR))
GOTO NR
SET AC=NR
SET SEQ="00"
QUIT
+1 WRITE !!?10,"OUT of ACCESSION Numbers for 19"_YR
SET Y=U
+2 QUIT
+3 ;
TOPNAM ;PRIMARY SITE and PRIMARY SITE CODE for header
+1 KILL SITTAB
+2 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
SET TOPCOD=""
SET TOPNAM=""
+3 IF TOP'=""
SET TOPNAM=$PIECE($GET(^ONCO(164,TOP,0)),U,1)
SET TOPCOD=$PIECE($GET(^ONCO(164,TOP,0)),U,2)
+4 SET SITTAB=79-$LENGTH(SITEGP)
SET TOPTAB=79-$LENGTH(TOPNAM_" "_TOPCOD)
+5 SET NOS=TOPTAB-$LENGTH(PATNAM)
SET NOS=NOS-1
KILL SPACES
SET $PIECE(SPACES," ",NOS)=" "
+6 QUIT
+7 ;
SECTION SET HDL=$LENGTH(SECTION)
SET TAB=(80-HDL)\2
SET TAB=TAB-1
+1 WRITE @IOF,DASHES
+2 WRITE !,?1,PATNAM,?TAB,SECTION,?SITTAB,SITEGP
+3 WRITE !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
+4 WRITE !,DASHES
+5 QUIT
+6 ;
EX ;Exit
+1 DO KILL^ONCOAI
+2 KILL ABSTAT,AC,C,CHECKSUM,D0,DASHES,DATEDX,DIE,H,HDL,HISTNAM,HSTFLD,IIN
+3 KILL L,MR,N,NODE0,NOS,NR,ONCDST,ONCOD0,ONCOD0P,ONCOEDIT,ONCONM,ONCOYR
+4 KILL PATNAM,RH,SAVED0,SECTION,SEQ,SITEGP,SITTAB,SSN,SY,T,TAB
+5 KILL TOP,TOPCOD,TOPNAM,TOPTAB,TXDT,X,XR,YR
+6 QUIT
+7 ;
CLEANUP ;Cleanup
+1 KILL COC,EXTVER
