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

ONCOGEN.m

Go to the documentation of this file.
  1. ONCOGEN ;Hines OIFO/GWB - GENERAL REPORT DRIVER FOR SELECTED FORMATS ;10/26/11
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. SU ;IR Patient Summary [ONCO ABSTRACT-INCOMP RECORD]
  1. ; look-ups for options IR, QA, EX and PA changed to look-up on
  1. ; file #165.5 to allow Accession Number look-up
  1. W !
  1. S DIC="^ONCO(165.5,",DIC(0)="AEQZM"
  1. S DIC("A")="Select primary or patient name: " D ^DIC G SUEX:Y<0
  1. S D0=+Y
  1. S BY="NUMBER",(FR,TO)=D0,FLDS="[ONCO XABSTRACT RECORD]",L=0
  1. S DIC="^ONCO(165.5,",L=0 D EN1^DIP
  1. K DIR S DIR(0)="E" D ^DIR
  1. SUEX K DIC,D,BY,FR,TO,FLDS,L
  1. Q
  1. ;
  1. SEER ;[QA Print Abstract QA]
  1. S SEER=1 G ABSEO
  1. SER1 S ONCODA=DA
  1. D ESPD I ESPD[U K ESPD Q
  1. S FLDS=$S(ESPD:"[ONCQA2]",1:"[ONCQA1]")
  1. I $P($G(^ONCO(165.5,DA,2)),U,1)=67619 S FLDS="[ONCQA]"
  1. I ESPD,$P($G(^ONCO(165.5,DA,2)),U,1)=67619 S FLDS="[ONCQA3]"
  1. D PRT G END
  1. ;
  1. ABSEO ;[EX Print Abstract-Extended (80c)]
  1. ;[PA Print Complete Abstract (132c)]
  1. S DIC="^ONCO(165.5,",DIC(0)="AEQZM"
  1. S DIC("A")="Select primary or patient name: " D ^DIC G SUEX:Y<0
  1. S (DA,D0,NUMBER)=+Y
  1. S PRTPCE=0
  1. I $P($G(^ONCO(165.5,DA,7)),U,15)'="" W ! K DIR S DIR(0)="YA",DIR("A")=" Print PCE data attached to this primary? ",DIR("B")="NO" D ^DIR
  1. S PRTPCE=Y G EX:$D(DIRUT)
  1. G SER1:$D(SEER),DS:$D(NS),X:III<49,Y
  1. X S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
  1. I OSP="" S OSP=$O(^ONCO(160.1,0))
  1. D ESPD I ESPD[U K ESPD Q
  1. S (ONCODA,ONCOIEN)=DA D ^ONCOPA1
  1. G EX
  1. Y S DIOEND="S DN=1,D0=ONCODA F II=III:1:IIII K DXS D @(""^ONCOY""_II)"
  1. PT S ONCODA=DA,FLDS="[ONCOY49]"
  1. D PRT G END
  1. PRT S FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0
  1. D EN1^DIP
  1. Q
  1. ;
  1. PRT1 S FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(160,",L=0
  1. D EN1^DIP
  1. Q
  1. TEXT W:$D(^ONCO(165.5,DA,8)) " "_$P(^ONCO(165.5,DA,8),U,1) Q
  1. DD S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"0000",11,12),1:"")
  1. Q
  1. ;
  1. DIS ;[AS Abstract Screens Menu (80c)...]
  1. G ABSEO
  1. DS S (D0,ONCODA)=DA
  1. I $G(NF)=58 S III=50,IIII=58 D Y G END
  1. S FLDS="[ONCOY49]",FR=ONCODA,TO=ONCODA,BY="@NUMBER",L=0
  1. S DIC="^ONCO(165.5," D @("SCR"_NS) Q
  1. SCR50 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY50"")" D EN1^DIP,RD Q
  1. SCR3 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOX3"")" D EN1^DIP,RD Q
  1. SCR51 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY51"")" D EN1^DIP,RD Q
  1. SCR52 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY52"")" D EN1^DIP,RD Q
  1. SCR53 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY53"")" D EN1^DIP,RD Q
  1. SCR54 S DIOEND="S DN=1,D0=ONCODA F II=54,55 K DXS D @(""^ONCOY""_II)"
  1. D EN1^DIP Q
  1. SCR56 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY56"")" D EN1^DIP,RD Q
  1. SCR57 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY57"")" D EN1^DIP,RD Q
  1. SCR58 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY58"")" D EN1^DIP,RD Q
  1. Q
  1. ;
  1. RD K DIR S DIR(0)="E",DIR("A")="Hit Enter to continue" D ^DIR
  1. K QDS I Y'=1 S QDS=1
  1. Q
  1. ;
  1. END D ^%ZISC S IOP=ION D ^%ZIS
  1. ;
  1. EX ;Exit
  1. K ANS,BY,C,D,D0,DA,DATEDX,DIC,DIOEND,DIRUT,FLDS,FR,HDA,HI,I,III,IIII,L
  1. K NF,NS,NODE0,NUMBER,ONCODA,ONCOIEN,ONCOIO,ONCONUM,ONCOPA,ONCOQUIT,ONCQ
  1. K ONCX,OSP,PCEABS,PCESEL,POP,PRTPCE,QDS,S,SAVED0,SI,SEER,SITTAB,SSN
  1. K STGP,STGPNM,TO,TOP,TOPCOD,TOPNAM,TOPTAB,TTAB
  1. Q
  1. ;
  1. PCEPRT ;PRINT PCE DATA (IF ANY) FOR A PARTICULAR PRIMARY AFTER COMPLETE
  1. ;(OR EXT) ABSTR PRINT. CALLED BY ROUTINE ^ONCOPA3A (FORMERLY CALLED
  1. ;BY ONCOX11 PRINT TEMPLATE). ALSO CALLED BY [ONCOY58] PRINT TEMPLATE.
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="" Q ;IF NO PCE DATA, QUIT
  1. S STGP=$P($G(^ONCO(165.5,ONCODA,0)),U,1)
  1. S STGPNM=$P($G(^ONCO(164.2,STGP,0)),U,1),SITTAB=79-$L(STGPNM)
  1. PRINT ;
  1. D PCEVARS
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="BLA" D PRT^ONCBPC8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="THY" D PRT^ONCTPC8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="STS" D PRT^ONCSPC8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="PRO" D PRT^ONCPPC9 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="COL" D PRT^ONCCPC9 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="NHL" D PRT^ONCNPC8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="PRO2" D PRT^ONCP2P8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="BRE" D PRT^ONCBRP9 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="MEL" D PRT^ONCMPC9 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="HEP" D PRT^ONCHPC8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="CNS" D PRT^ONCIPC8 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="GAS" D PRT^ONCGPC7 Q
  1. I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="LNG" D PRT^ONCLPC9 Q
  1. Q
  1. PCEPRT2 ;PRINT ALL PCE'S FOR A PARTICULAR SITE.
  1. S ONCQ=0
  1. W !!?5,"Print PCE's for a particular site"
  1. K DIR S DIR(0)="SM^1:Bladder;2:Thyroid;3:Soft Tissue Sarcoma;4:Prostate;5:Prostate (1998);6:Colorectal;7:Non-Hodgkin's Lymphoma;8:Breast;9:Melanoma;10:Hepatocellular;11:Intracranial;12:Gastric;13:Lung" D ^DIR Q:$D(DIRUT)
  1. S PCESEL=$S(Y=1:"BLA",Y=2:"THY",Y=3:"STS",Y=4:"PRO",Y=5:"PRO2",Y=6:"COL",Y=7:"NHL",Y=8:"BRE",Y=9:"MEL",Y=10:"HEP",Y=11:"CNS",Y=12:"GAS",Y=13:"LNG",1:"") Q:PCESEL=""
  1. W ! K DIR S DIR(0)="YA",DIR("A")="Print PCE's AND Abstracts? ",DIR("B")="Y" D ^DIR S PCEABS=Y G EX:$D(DIRUT)
  1. K IOP,%ZIS S %ZIS="Q" W ! D ^%ZIS S ONCOIO=ION_";"_IOST_";"_IOM_";"_IOSL G:POP EX
  1. I $D(IO("Q")) S ONCQ=1 D TASK G EX
  1. RTN ;
  1. S ONCOQUIT=0,ONCIOST=IOST
  1. I PCEABS'=1 F ONCX=0:0 S ONCX=$O(^ONCO(165.5,"APCE",PCESEL,ONCX)) Q:ONCX'>"" I $$DIV^ONCFUNC(ONCX)=DUZ(2) S ONCODA=ONCX D PRINT Q:$G(Y)=0
  1. I PCEABS=1 F ONCX=0:0 S ONCX=$O(^ONCO(165.5,"APCE",PCESEL,ONCX)) Q:ONCX'>""!ONCOQUIT I $$DIV^ONCFUNC(ONCX)=DUZ(2) D
  1. .S ONCODA=ONCX,PRTPCE=1
  1. .S ONCOIEN=ONCX D MULT^ONCOPA1
  1. .Q
  1. G END
  1. PCEVARS ;SET VARIABLES NEEDED TO PRINT THE PCE(S).
  1. N PATNAM K DASHES S $P(DASHES,"-",80)="-"
  1. S D0=ONCODA,NODE0=^ONCO(165.5,D0,0)
  1. S S=$P(NODE0,U,1),SITEGP=$P(^ONCO(164.2,S,0),U,1),DATEDX=$P(NODE0,U,16)
  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 TOP=$P($G(^ONCO(165.5,D0,2)),U,1),TOPCOD="",TOPNAM=""
  1. I TOP'="" S TOPNAM=$P(^ONCO(164,TOP,0),U,1),TOPCOD=$P(^ONCO(164,TOP,0),U,2)
  1. S TOPTAB=79-$L(TOPNAM_" "_TOPCOD),TTAB=79-$L(TOPCOD)
  1. S STGP=$P($G(^ONCO(165.5,ONCODA,0)),U,1)
  1. S STGPNM=$P($G(^ONCO(164.2,STGP,0)),U,1),SITTAB=79-$L(STGPNM)
  1. S NOS=TOPTAB-$L(PATNAM),NOS=NOS-1 K SPACES S $P(SPACES," ",NOS)=" "
  1. S ONCONUM=D0,ONCOPA=$P(NODE0,U,2)
  1. Q
  1. ;
  1. ESPD ;Exclude sensitive patient data
  1. N DIR,X,Y
  1. W !
  1. S DIR("A")=" Exclude sensitive patient data"
  1. S DIR(0)="Y",DIR("B")="No" D ^DIR
  1. S ESPD=Y
  1. Q
  1. ;
  1. TASK ;Queue a task
  1. K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
  1. S ZTRTN="RTN^ONCOGEN"
  1. S ZTREQ="@",ZTSAVE("ZTREQ")="",ZTSAVE("ONCODA")="",ZTSAVE("PCESEL")=""
  1. S ZTSAVE("DATEDX")="",ZTSAVE("PCEABS")="",ZTSAVE("ONCOIO")=""
  1. S ZTSAVE("ONCQ")="",ZTDESC="Print PCE Data"
  1. D ^%ZTLOAD W !,"Request Queued",!
  1. K ZTDESC,ZTREQ,ZTRTN,ZTSAVE
  1. Q
  1. ;
  1. CLEANUP ;Cleanup
  1. K NOS,ONCIOST,SITEGP