Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOAIP

ONCOAIP.m

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