- ONCOAIP ;HINES OIFO/GWB - [EE Abstract Edit Primary] ;09/26/11
- ;;2.2;ONCOLOGY;**1,4,5,6,10,15,16,20**;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)
- S NTDD=$P($G(^ONCO(165.5,D0,2.1)),U,11)
- I '$D(NTDD) S Y=138.4 Q
- I (NTDD="")!(NTDD="0000000")!(NTDD=9999999) S Y=138.4 Q
- ;I $P($G(^ONCO(165.5,D0,2.1)),U,11)="" S Y=138.4 Q
- K NTDD
- W !!?5,"You have entered a DATE OF NO TREATMENT. Relevant treatment"
- W !?5,"fields 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
- S NTX=1 D NTX^ONCNTX ;K NTX
- 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 12489 printed Feb 18, 2025@23:50:43 Page 2
- ONCOAIP ;HINES OIFO/GWB - [EE Abstract Edit Primary] ;09/26/11
- +1 ;;2.2;ONCOLOGY;**1,4,5,6,10,15,16,20**;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 SET NTDD=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,11)
- +2 IF '$DATA(NTDD)
- SET Y=138.4
- QUIT
- +3 IF (NTDD="")!(NTDD="0000000")!(NTDD=9999999)
- SET Y=138.4
- QUIT
- +4 ;I $P($G(^ONCO(165.5,D0,2.1)),U,11)="" S Y=138.4 Q
- +5 KILL NTDD
- +6 WRITE !!?5,"You have entered a DATE OF NO TREATMENT. Relevant treatment"
- +7 WRITE !?5,"fields will be stuffed with the appropriate value indicating no"
- +8 WRITE !?5,"treatment.",!
- +9 KILL DIR
- SET DIR("A")="Are you sure you want to do this"
- SET DIR("B")="No"
- +10 SET DIR(0)="Y"
- DO ^DIR
- +11 IF (Y=0)!(Y="")
- Begin DoDot:1
- +12 SET TXDT=$PIECE(^ONCO(165.5,D0,2.1),U,11)_"N"
- +13 KILL ^ONCO(165.5,"ATX",D0,TXDT)
- +14 SET $PIECE(^ONCO(165.5,D0,2.1),U,11)=""
- End DoDot:1
- SET Y=124
- WRITE !
- QUIT
- +15 IF Y[U
- SET $PIECE(^ONCO(165.5,D0,2.1),U,11)=""
- SET Y="@0"
- QUIT
- +16 ;S NTX="" D NTX^ONCNTX K NTX,ONCRK1ST
- +17 ;K NTX
- SET NTX=1
- DO NTX^ONCNTX
- +18 QUIT
- +19 ;
- 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