263 lines
9.2 KiB
Mathematica
263 lines
9.2 KiB
Mathematica
ONCOAIP ;Hines OIFO/GWB [EE Abstract Edit Primary]; 08/29/01
|
|
;;2.11;ONCOLOGY;**1,5,6,7,11,13,15,16,18,19,22,24,27,28,32,33,34,35,36,37,38,39,40,42,43,44,45,46,47**;Mar 07, 1995;Build 19
|
|
;
|
|
ED ;[EE Abstract Edit Primary]
|
|
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 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)
|
|
I ABSTAT=3,CHECKSUM="" D
|
|
.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 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
|
|
S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
|
|
I ABSTAT'=3 D
|
|
.S DIE="^ONCO(165.5,"
|
|
.S DA=ONCOD0P
|
|
.S DR="197///@"
|
|
.D ^DIE
|
|
I ABSTAT=3 D CHANGE^ONCGENED I $G(Y)="@0" G EN
|
|
D FOL^ONCOAI
|
|
K ONCOL1,LYMPHOMA,RFDEF,TFDEF,DFDEF
|
|
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)
|
|
S TEXT=HISTNAM
|
|
S:$P($G(^ONCO(165.5,D0,8)),U,2)="" $P(^ONCO(165.5,D0,8),U,2)=$E(TEXT,1,40)
|
|
K HSTI,TEXT
|
|
D:$P($G(^ONCO(165.5,D0,0)),U,16)>3031231 ^ONCCSSTF
|
|
Q
|
|
;
|
|
MEN ;Primary Menu Options
|
|
K DXS,ONCOOUT,DASHES
|
|
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=$P(NODE0,U,4)
|
|
S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I OSP="" S OSP=$O(^ONCO(160.1,0))
|
|
S EVADS=$P($G(^ONCO(160.1,OSP,2)),U,2)
|
|
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. Patient Care Evaluation"
|
|
W !?22,"6. Over-ride Flags"
|
|
W !?22,"7. Case Administration"
|
|
W !!?22,"A All - Complete Abstract"
|
|
;
|
|
A K AN,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
|
|
S (ONCOANS,Y)=X I X<1!(X>7) W *7,"??" G A
|
|
;
|
|
Y S Y="@"_Y
|
|
Q
|
|
;
|
|
HP W !!,?10,"Select 'A' for the complete abstract"
|
|
W !?10,"Select 1-7 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
|
|
.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
|
|
.S $P(^ONCO(165.5,D0,2),U,9,17)=N
|
|
.D NOSTAGE
|
|
.S SY="@313" ;Other Staging System (165.5,39)
|
|
.I S=65 W !?18,"====> UNKNOWN PRIMARY - No EOD/TNM coding <====" Q
|
|
.W !?18,"====> SYSTEMIC DISEASE - No EOD/TMN 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),U,25)=88 ;37.1 CT
|
|
S $P(^ONCO(165.5,D0,2),U,26)=88 ;37.2 CN
|
|
S $P(^ONCO(165.5,D0,2),U,27)=88 ;37.3 CM
|
|
S $P(^ONCO(165.5,D0,2),U,20)=88 ;38 C Stage Group
|
|
S $P(^ONCO(165.5,D0,3),U,32)=8 ;19 Staged By (C)
|
|
S $P(^ONCO(165.5,D0,7),U,17)="N" ;69.4 Multimodality Therapy (P)
|
|
S $P(^ONCO(165.5,D0,2.1),U,1)=88 ;85 PT
|
|
S $P(^ONCO(165.5,D0,2.1),U,2)=88 ;86 PN
|
|
S $P(^ONCO(165.5,D0,2.1),U,3)=88 ;87 PM
|
|
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)=8 ;89 Staged By (P)
|
|
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
|
|
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
|
|
Q
|
|
;
|
|
RS ;RADIATION/SURGERY SEQUENCE (165.5,51.3)
|
|
Q:$P(^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
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="90:92;198;199;155;157"
|
|
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
|
|
W !," Abstract Status...........: ",ONC(165.5,D0,91)
|
|
W !," Date of First Contact.....: ",ONC(165.5,D0,155)
|
|
W !," Date Case Completed.......: ",ONC(165.5,D0,90)
|
|
W !," Elapsed Days to Completion: ",ONC(165.5,D0,157)
|
|
W !," Abstracted by.............: ",ONC(165.5,D0,92)
|
|
W !," Date Case Last Changed....: ",ONC(165.5,D0,198)
|
|
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 *7,!!?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 *7,!!?10,"OUT of ACCESSION Numbers for 19"_YR S Y=U
|
|
Q
|
|
;
|
|
TOPNAM ;PRIMARY SITE and PRIMARY SITE CODE for header
|
|
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1),TOPCOD="",TOPNAM=""
|
|
I TOP'="" S TOPNAM=$P(^ONCO(164,TOP,0),U,1),TOPCOD=$P(^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 ONCOEDIT
|
|
Q
|