- ONCOPA1 ;HINES OIFO/GWB - [PA Print Complete Abstract (132c)] ;09/22/11
- ;;2.2;ONCOLOGY;**1,5,6,9,10,12,13,20**;Jul 31, 2013;Build 5
- ;
- ;Replaces print templates ONCOX1-X11.
- ;
- K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP EXIT
- I $D(IO("Q")) S ONCOLST="ONCOIEN^PTIEN^STARS^LENGTH^TITLE^PRTPCE^ONCODA^ESPD" D TASK G EXIT
- U IO D PRINT D ^%ZISC K %ZIS,IOP G EXIT
- ;
- PRINT ;Print
- Q:$G(ONCOIEN)=""
- W @IOF
- S (IEN,D0)=ONCOIEN,PTIEN=$P($G(^ONCO(165.5,IEN,0)),U,2)
- S PG=0,EX="",LINE=$S($E(IOST,1,2)="C-":IOSL-2,1:IOSL-6)
- S STARS="******************************************************************************"
- S DATEDX=$P($G(^ONCO(165.5,IEN,0)),U,16)
- D NOW^%DTC S Y=% K % D DD^%DT S PRTDATE=Y
- K DIQ S DIC="^ONCO(160,",DIQ(0)="C"
- S DR=".111:.131;2;7:10;13;18.9:21;22.9:29;38:44;48;50;51;52;61;55;56;62;63;64;65;66;67;68;72;73;1006"
- S DA=PTIEN,DIQ="ONCAB" D EN^DIQ1
- K DIQ S DIC="^ONCO(165.5,",DIQ(0)="C"
- S DR=".01:.07;1.2;2:2.4;3;3.5:19;20.1;22:35.1;37:40.2;41;49:59;62:67;70:71.3;74:79;83;85:92;95;100;101;108;117:146;200;346;363;363.1;442;443;560;787;50.2;361;623;684;1010;153:153.3;435;149;151;154:156;170;171:192;711:713;809;1764;5501:5527"
- S DA=ONCOIEN,DIQ="ONCAB" D EN^DIQ1
- K DIQ S DIC="^ONCO(165.5,",DIQ(0)="IE"
- S DR="29.2;30.2;29.1;31.1;32.1;32;33:35;44.1:44.9;160:168;148:148.4;15;21;25;44;46;47;96;102;159;193;194;195;196;2.2;227:235;1423:1423.4;157.1;24.1:24.6;237;237.1;34.31:34.6;241;242;245:250;279:281;1764;5501:5527;7013:7026"
- S DA=ONCOIEN,DIQ="ONCAB" D EN^DIQ1
- K DIQ S DIC="^ONCO(165.5,",DIQ(0)="C"
- S DR="72",DA=ONCOIEN,DR(165.572)=".01;.02;.03;.031;.032",DIQ="ONCAB"
- F SR=0:0 S SR=$O(^ONCO(165.5,IEN,23,SR)) Q:SR'>0 D
- .S DA(165.572)=SR D EN^DIQ1 Q
- K DIQ S DIC="^ONCO(165.5,",DIQ(0)="C"
- S DR="60",DA=ONCOIEN,DR(165.51)=".01:2;33:37",DIQ="ONCAB"
- F SCT=0:0 S SCT=$O(^ONCO(165.5,IEN,4,SCT)) Q:SCT'>0 D
- .S DA(165.51)=SCT D EN^DIQ1 Q
- K DIQ S DIC="^ONCO(160,",DIQ(0)="C"
- S DR="44",DA=PTIEN,DR(160.044)=".01:1",DIQ="ONCAB"
- F CHST=0:0 S CHST=$O(^ONCO(160,PTIEN,9,CHST)) Q:CHST'>0 D
- .S DA(160.044)=CHST D EN^DIQ1 Q
- I $G(ESPD)=1 D
- .S ONCAB(165.5,IEN,.02)="XXXXX,XXXXX"
- .S ONCAB(160,PTIEN,2)="XXX-XX-XXXX"
- .S ONCAB(160,PTIEN,.119)="XXXXXXXXXX"
- .S $P(ONCAB(160,PTIEN,.116),",",1)="XXXXX"
- .S ONCAB(160,PTIEN,.131)="XXX-XXX-XXXX"
- .S ONCAB(165.5,IEN,8)="XXXXXXXXXX"
- .S ONCAB(165.5,IEN,8.2)="XXXXXXXXXX"
- .S ONCAB(165.5,IEN,8.1)="XXXXX"
- S PATNAME=$G(ONCAB(165.5,IEN,.02)),SSAN=$G(ONCAB(160,PTIEN,2))
- S NAME="CANCER REGISTRY ABSTRACT" D FORMAT
- S CRA=TITLE W !!,TITLE
- W !!?21,$E(ONCAB(165.5,IEN,.03),1,26)
- W " ACOS #: ",ONCAB(165.5,IEN,67)
- W ?76,"Print Date: ",PRTDATE D P Q:EX=U
- W !," Patient Name: ",ONCAB(165.5,IEN,.02),?76,"SSN: ",ONCAB(160,PTIEN,2) D P Q:EX=U
- S DOB="",VRBLPTR=$P($G(^ONCO(160,PTIEN,0)),U,1) I VRBLPTR'="" D
- .S FILE=U_$P(VRBLPTR,";",2)_$P(VRBLPTR,";",1)_",0)"
- .S Y=$S($D(@FILE):$P(@FILE,U,3),1:"") I Y'="" D DD^%DT S DOB=Y Q
- W !," Home Address: ",ONCAB(160,PTIEN,.119) D P Q:EX=U
- W !," ",ONCAB(160,PTIEN,.118) D P Q:EX=U
- W !," County: ",ONCAB(160,PTIEN,.12) D P Q:EX=U
- W !," Sex: ",$E(ONCAB(160,PTIEN,10),1,14),?44,"Race: ",$E(ONCAB(160,PTIEN,8),1,21),?76,"Ethnicity: ",ONCAB(160,PTIEN,9) D P Q:EX=U
- W !," Date of Birth: ",DOB
- W ?38," Age at DX: ",ONCAB(165.5,IEN,4) D P Q:EX=U
- ;
- CI ;Cancer Identification
- S NAME="CANCER IDENTIFICATION" D FORMAT
- W !!,TITLE
- S NODE2=$G(^ONCO(165.5,IEN,2))
- S COC=$E($$GET1^DIQ(165.5,IEN,.04),1,2)
- W !!," Accession Number: ",ONCAB(165.5,IEN,.05),?38,"Accession Year: ",ONCAB(165.5,IEN,.07),?76,"Sequence Number: ",ONCAB(165.5,IEN,.06) D P Q:EX=U
- W !," Date Dx: ",ONCAB(165.5,IEN,3) D P Q:EX=U
- I (DATEDX>3061231)&(DATEDX<3180000) D
- .W !," Ambiguous Terminology Dx: ",ONCAB(165.5,IEN,159,"E") D P Q:EX=U
- .W !," Date of Conclusive Dx: ",ONCAB(165.5,IEN,193,"E") D P Q:EX=U
- W !," Dx Facility: ",ONCAB(165.5,IEN,5) D P Q:EX=U
- W !," Date of First Contact: ",ONCAB(165.5,IEN,155) D P Q:EX=U
- I DATEDX>3091231 D
- .W !," Inpatient Status: ",ONCAB(165.5,IEN,233,"E") D P Q:EX=U
- W !," Class of Case: ",ONCAB(165.5,IEN,.04) D P Q:EX=U
- W !," Date of First Symptoms: ",ONCAB(165.5,IEN,171) D P Q:EX=U
- W !," Date Start Workup Ordered: ",ONCAB(165.5,IEN,172) D P Q:EX=U
- W !," Date Workup Started: ",ONCAB(165.5,IEN,173) D P Q:EX=U
- W !," Type of Reporting Source: ",ONCAB(165.5,IEN,1.2) D P Q:EX=U
- W !," Site/Gp: ",ONCAB(165.5,IEN,.01) D P Q:EX=U
- W !," Primary Site Code: ",ONCAB(165.5,IEN,20.1)," "
- S TOP=$P(NODE2,U,1) I TOP'="" W $P(^ONCO(164,TOP,0),U,1) D P Q:EX=U
- W !," Text-Primary Site Title: ",ONCAB(165.5,IEN,100) D P Q:EX=U
- I (DATEDX>3061231)&(DATEDX<3130000) D
- .W !," Mult Tum Rpt as One Prim: ",ONCAB(165.5,IEN,194,"E") D P Q:EX=U
- .W !," Date of Multiple Tumors: ",ONCAB(165.5,IEN,195,"E") D P Q:EX=U
- .W !," Multiplicity Counter: ",ONCAB(165.5,IEN,196,"E") D P Q:EX=U
- W !," Laterality: ",ONCAB(165.5,IEN,28) D P Q:EX=U
- S HIST=$$HIST^ONCFUNC(IEN,.HSTFLD)
- W !," Histology: ",$G(HIST)," ",ONCAB(165.5,IEN,HSTFLD) D P Q:EX=U
- W !," Text-Histology Title: ",ONCAB(165.5,IEN,101) D P Q:EX=U
- W:TOP=67619 !," Gleason Score (Clin): ",ONCAB(165.5,IEN,623)
- W:TOP=67619 !," Gleason Score (Path): ",ONCAB(165.5,IEN,250,"E")
- W:TOP=67619 !," PSA: ",ONCAB(165.5,IEN,684)
- W:TOP=67619 !," PSA Date: ",ONCAB(165.5,IEN,96,"E")
- W:TOP=67619 !," DRE +/-: ",ONCAB(165.5,IEN,102,"E")
- W:TOP=67619 !," DRE Date: ",ONCAB(165.5,IEN,156)
- I DATEDX<3180000 W !," Grade/Differentiation: ",ONCAB(165.5,IEN,24)," "
- S GR=$P(NODE2,U,5) I GR'="" W $P(^ONCO(164.43,GR,0),U,2) D P Q:EX=U
- I (DATEDX>3091231)&(DATEDX<3160000) D
- .W !," Grade Path System: ",ONCAB(165.5,IEN,24.1,"E") D P Q:EX=U
- .W !," Grade Path Value: ",ONCAB(165.5,IEN,24.2,"E") D P Q:EX=U
- I DATEDX>3171231 D
- .W !," Grade Clinical: ",ONCAB(165.5,IEN,24.3,"E") D P Q:EX=U
- .W !," Grade Pathological: ",ONCAB(165.5,IEN,24.4,"E") D P Q:EX=U
- .W !,"Grade Post Therapy Clin(yc): ",ONCAB(165.5,IEN,24.6,"E") D P Q:EX=U
- .W !,"Grade Post Therapy Path(yp): ",ONCAB(165.5,IEN,24.5,"E") D P Q:EX=U
- W !," AFIP/JPC Submission: ",ONCAB(165.5,IEN,83) D P Q:EX=U
- W !," Diagnostic Confirmation: ",ONCAB(165.5,IEN,26) D P Q:EX=U
- W:TOP=67220 !," Hepatitis C: ",ONCAB(165.5,IEN,1010)
- I DATEDX<3040000 D
- .S TM1=$$PRINT^ONCOTM(IEN,1)
- .I TM1["UMOR" S $E(TM1,2,5)="umor" I TM1["ARKER" S $E(TM1,8,12)="arker"
- .S TM2=$$PRINT^ONCOTM(IEN,2)
- .I TM2["UMOR" S $E(TM2,2,5)="umor" I TM2["ARKER" S $E(TM2,8,12)="arker"
- .S TM3=$$PRINT^ONCOTM(IEN,3)
- .I TM3["UMOR" S $E(TM3,2,5)="umor" I TM3["ARKER" S $E(TM3,8,12)="arker"
- .S LEN=$L(TM1) W !?(27-LEN),TM1,": ",ONCAB(165.5,IEN,25.1) D P Q:EX=U
- .S LEN=$L(TM2) W !?(27-LEN),TM2,": ",ONCAB(165.5,IEN,25.2) D P Q:EX=U
- .S LEN=$L(TM3) W !?(27-LEN),TM3,": ",ONCAB(165.5,IEN,25.3) D P Q:EX=U
- W !," Facility Referred From: ",ONCAB(165.5,IEN,6) D P Q:EX=U
- W !," Facility Referred To: ",ONCAB(165.5,IEN,7) D P Q:EX=U
- W !," Fee Basis: ",ONCAB(165.5,IEN,237,"E") D P Q:EX=U
- W !," Fee Basis Location: ",ONCAB(165.5,IEN,237.1,"E") D P Q:EX=U
- W !,"Presentation at Cancer Conf: ",ONCAB(165.5,IEN,120) D P Q:EX=U
- W !," Date of Cancer Conference: ",ONCAB(165.5,IEN,121) D P Q:EX=U
- W !," Casefinding Source: ",ONCAB(165.5,IEN,21,"E")
- ;
- I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR Q:'Y D HDR G PA1A
- D P Q:EX=U
- PA1A D ^ONCOPA1A
- ;
- EXIT ;KILL variables
- K CHST,CMIEN,CNTR,COC,CRA,D0,DA,DATEDX,DIC,DIQ,DIR,DOB,DR,DTE,DXDT,EX
- K FHDT,FHIEN,FHZN,FILE,FLG,FM,FOLH,FR,GR,HIST,HSTFLD,IC,ICDCD,IEN,LEN
- K LENGTH,LINE,NAME,NF,NODE2,NOK,NUM,ONCAB,ONCOIEN,ONCOLST,OTHPRI,PATH
- K PATNAME,PG,POP,PRI,PRTDATE,PRTPCE,PRZN,PTIEN,QS,RCDT,REG,REG1,RK,RK1
- K SCT,SITE,SR,SSAN,ST,STARS,TITLE,TM1,TM2,TM3,TOP,TPX,TSIEN,TSTAT,UF
- K VRBLPTR,VS,Y,ZN
- Q
- ;
- P ;Enter RETURN to continue
- I $Y>(IOSL-10) D Q:EX=U W !
- .I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR I 'Y S EX=U Q
- .D HDR Q
- Q
- ;
- FORMAT ;
- S LENGTH=$L(NAME),NUM=(((132-LENGTH)/2)\1)-10
- S TITLE=" "_$E(STARS,1,NUM)_" "_NAME_" "_$E(STARS,1,NUM)
- Q
- ;
- TASK ;Report Queued
- K ZTUCI,ZTDTH,ZTIO,ZTSAVE
- S ZTRTN="PRINT^ONCOPA1",ZTREQ="@",ZTSAVE("ZTREQ")=""
- S ZTDESC="Print Complete Abstract"
- F RK=1:1 S RK1=$P(ONCOLST,U,RK) Q:RK1="" S ZTSAVE(RK1)=""
- D ^%ZTLOAD D ^%ZISC U IO W !,"Report Queued",!
- K ZTDESC,ZTREQ,ZTRTN,ZTSAVE,ZTSK
- Q
- ;
- HDR ;Header
- W @IOF S PG=PG+1
- W CRA,!
- W ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
- Q
- ;
- MULT ;Entry point for option ABS...MA...3).
- ;Also called from PCEPRT2^ONCOGEN.
- I $D(IO("Q")) S ONCOLST="ONCOIEN^PTIEN^STARS^LENGTH^TITLE^PRTPCE^ONCODA^ESPD" D TASK G EXIT
- U IO D PRINT K %ZIS,IOP G EXIT
- Q
- ;
- CLEANUP ;Cleanup
- K ESPD
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPA1 9248 printed Jan 18, 2025@03:26:23 Page 2
- ONCOPA1 ;HINES OIFO/GWB - [PA Print Complete Abstract (132c)] ;09/22/11
- +1 ;;2.2;ONCOLOGY;**1,5,6,9,10,12,13,20**;Jul 31, 2013;Build 5
- +2 ;
- +3 ;Replaces print templates ONCOX1-X11.
- +4 ;
- +5 KILL IOP,%ZIS
- SET %ZIS="MQ"
- WRITE !
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO EXIT
- +6 IF $DATA(IO("Q"))
- SET ONCOLST="ONCOIEN^PTIEN^STARS^LENGTH^TITLE^PRTPCE^ONCODA^ESPD"
- DO TASK
- GOTO EXIT
- +7 USE IO
- DO PRINT
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO EXIT
- +8 ;
- PRINT ;Print
- +1 if $GET(ONCOIEN)=""
- QUIT
- +2 WRITE @IOF
- +3 SET (IEN,D0)=ONCOIEN
- SET PTIEN=$PIECE($GET(^ONCO(165.5,IEN,0)),U,2)
- +4 SET PG=0
- SET EX=""
- SET LINE=$SELECT($EXTRACT(IOST,1,2)="C-":IOSL-2,1:IOSL-6)
- +5 SET STARS="******************************************************************************"
- +6 SET DATEDX=$PIECE($GET(^ONCO(165.5,IEN,0)),U,16)
- +7 DO NOW^%DTC
- SET Y=%
- KILL %
- DO DD^%DT
- SET PRTDATE=Y
- +8 KILL DIQ
- SET DIC="^ONCO(160,"
- SET DIQ(0)="C"
- +9 SET DR=".111:.131;2;7:10;13;18.9:21;22.9:29;38:44;48;50;51;52;61;55;56;62;63;64;65;66;67;68;72;73;1006"
- +10 SET DA=PTIEN
- SET DIQ="ONCAB"
- DO EN^DIQ1
- +11 KILL DIQ
- SET DIC="^ONCO(165.5,"
- SET DIQ(0)="C"
- +12 SET DR=".01:.07;1.2;2:2.4;3;3.5:19;20.1;22:35.1;37:40.2;41;49:59;62:67;70:71.3;74:79;83;85:92;95;100;101;108;117:146;200;346;363;363.1;442;443;560;787;50.2;361;623;684;1010;153:153.3;435;149;151;154:156;170;171:192;711:713;809;1764;5501:5527"
- +13 SET DA=ONCOIEN
- SET DIQ="ONCAB"
- DO EN^DIQ1
- +14 KILL DIQ
- SET DIC="^ONCO(165.5,"
- SET DIQ(0)="IE"
- +15 SET DR="29.2;30.2;29.1;31.1;32.1;32;33:35;44.1:44.9;160:168;148:148.4;15;21;25;44;46;47;96;102;159;193;194;195;196;2.2;227:235;1423:1423.4;157.1;24.1:24.6;237;237.1;34.31:34.6;241;242;245:250;279:281;1764;5501:5527;7013:7026"
- +16 SET DA=ONCOIEN
- SET DIQ="ONCAB"
- DO EN^DIQ1
- +17 KILL DIQ
- SET DIC="^ONCO(165.5,"
- SET DIQ(0)="C"
- +18 SET DR="72"
- SET DA=ONCOIEN
- SET DR(165.572)=".01;.02;.03;.031;.032"
- SET DIQ="ONCAB"
- +19 FOR SR=0:0
- SET SR=$ORDER(^ONCO(165.5,IEN,23,SR))
- if SR'>0
- QUIT
- Begin DoDot:1
- +20 SET DA(165.572)=SR
- DO EN^DIQ1
- QUIT
- End DoDot:1
- +21 KILL DIQ
- SET DIC="^ONCO(165.5,"
- SET DIQ(0)="C"
- +22 SET DR="60"
- SET DA=ONCOIEN
- SET DR(165.51)=".01:2;33:37"
- SET DIQ="ONCAB"
- +23 FOR SCT=0:0
- SET SCT=$ORDER(^ONCO(165.5,IEN,4,SCT))
- if SCT'>0
- QUIT
- Begin DoDot:1
- +24 SET DA(165.51)=SCT
- DO EN^DIQ1
- QUIT
- End DoDot:1
- +25 KILL DIQ
- SET DIC="^ONCO(160,"
- SET DIQ(0)="C"
- +26 SET DR="44"
- SET DA=PTIEN
- SET DR(160.044)=".01:1"
- SET DIQ="ONCAB"
- +27 FOR CHST=0:0
- SET CHST=$ORDER(^ONCO(160,PTIEN,9,CHST))
- if CHST'>0
- QUIT
- Begin DoDot:1
- +28 SET DA(160.044)=CHST
- DO EN^DIQ1
- QUIT
- End DoDot:1
- +29 IF $GET(ESPD)=1
- Begin DoDot:1
- +30 SET ONCAB(165.5,IEN,.02)="XXXXX,XXXXX"
- +31 SET ONCAB(160,PTIEN,2)="XXX-XX-XXXX"
- +32 SET ONCAB(160,PTIEN,.119)="XXXXXXXXXX"
- +33 SET $PIECE(ONCAB(160,PTIEN,.116),",",1)="XXXXX"
- +34 SET ONCAB(160,PTIEN,.131)="XXX-XXX-XXXX"
- +35 SET ONCAB(165.5,IEN,8)="XXXXXXXXXX"
- +36 SET ONCAB(165.5,IEN,8.2)="XXXXXXXXXX"
- +37 SET ONCAB(165.5,IEN,8.1)="XXXXX"
- End DoDot:1
- +38 SET PATNAME=$GET(ONCAB(165.5,IEN,.02))
- SET SSAN=$GET(ONCAB(160,PTIEN,2))
- +39 SET NAME="CANCER REGISTRY ABSTRACT"
- DO FORMAT
- +40 SET CRA=TITLE
- WRITE !!,TITLE
- +41 WRITE !!?21,$EXTRACT(ONCAB(165.5,IEN,.03),1,26)
- +42 WRITE " ACOS #: ",ONCAB(165.5,IEN,67)
- +43 WRITE ?76,"Print Date: ",PRTDATE
- DO P
- if EX=U
- QUIT
- +44 WRITE !," Patient Name: ",ONCAB(165.5,IEN,.02),?76,"SSN: ",ONCAB(160,PTIEN,2)
- DO P
- if EX=U
- QUIT
- +45 SET DOB=""
- SET VRBLPTR=$PIECE($GET(^ONCO(160,PTIEN,0)),U,1)
- IF VRBLPTR'=""
- Begin DoDot:1
- +46 SET FILE=U_$PIECE(VRBLPTR,";",2)_$PIECE(VRBLPTR,";",1)_",0)"
- +47 SET Y=$SELECT($DATA(@FILE):$PIECE(@FILE,U,3),1:"")
- IF Y'=""
- DO DD^%DT
- SET DOB=Y
- QUIT
- End DoDot:1
- +48 WRITE !," Home Address: ",ONCAB(160,PTIEN,.119)
- DO P
- if EX=U
- QUIT
- +49 WRITE !," ",ONCAB(160,PTIEN,.118)
- DO P
- if EX=U
- QUIT
- +50 WRITE !," County: ",ONCAB(160,PTIEN,.12)
- DO P
- if EX=U
- QUIT
- +51 WRITE !," Sex: ",$EXTRACT(ONCAB(160,PTIEN,10),1,14),?44,"Race: ",$EXTRACT(ONCAB(160,PTIEN,8),1,21),?76,"Ethnicity: ",ONCAB(160,PTIEN,9)
- DO P
- if EX=U
- QUIT
- +52 WRITE !," Date of Birth: ",DOB
- +53 WRITE ?38," Age at DX: ",ONCAB(165.5,IEN,4)
- DO P
- if EX=U
- QUIT
- +54 ;
- CI ;Cancer Identification
- +1 SET NAME="CANCER IDENTIFICATION"
- DO FORMAT
- +2 WRITE !!,TITLE
- +3 SET NODE2=$GET(^ONCO(165.5,IEN,2))
- +4 SET COC=$EXTRACT($$GET1^DIQ(165.5,IEN,.04),1,2)
- +5 WRITE !!," Accession Number: ",ONCAB(165.5,IEN,.05),?38,"Accession Year: ",ONCAB(165.5,IEN,.07),?76,"Sequence Number: ",ONCAB(165.5,IEN,.06)
- DO P
- if EX=U
- QUIT
- +6 WRITE !," Date Dx: ",ONCAB(165.5,IEN,3)
- DO P
- if EX=U
- QUIT
- +7 IF (DATEDX>3061231)&(DATEDX<3180000)
- Begin DoDot:1
- +8 WRITE !," Ambiguous Terminology Dx: ",ONCAB(165.5,IEN,159,"E")
- DO P
- if EX=U
- QUIT
- +9 WRITE !," Date of Conclusive Dx: ",ONCAB(165.5,IEN,193,"E")
- DO P
- if EX=U
- QUIT
- End DoDot:1
- +10 WRITE !," Dx Facility: ",ONCAB(165.5,IEN,5)
- DO P
- if EX=U
- QUIT
- +11 WRITE !," Date of First Contact: ",ONCAB(165.5,IEN,155)
- DO P
- if EX=U
- QUIT
- +12 IF DATEDX>3091231
- Begin DoDot:1
- +13 WRITE !," Inpatient Status: ",ONCAB(165.5,IEN,233,"E")
- DO P
- if EX=U
- QUIT
- End DoDot:1
- +14 WRITE !," Class of Case: ",ONCAB(165.5,IEN,.04)
- DO P
- if EX=U
- QUIT
- +15 WRITE !," Date of First Symptoms: ",ONCAB(165.5,IEN,171)
- DO P
- if EX=U
- QUIT
- +16 WRITE !," Date Start Workup Ordered: ",ONCAB(165.5,IEN,172)
- DO P
- if EX=U
- QUIT
- +17 WRITE !," Date Workup Started: ",ONCAB(165.5,IEN,173)
- DO P
- if EX=U
- QUIT
- +18 WRITE !," Type of Reporting Source: ",ONCAB(165.5,IEN,1.2)
- DO P
- if EX=U
- QUIT
- +19 WRITE !," Site/Gp: ",ONCAB(165.5,IEN,.01)
- DO P
- if EX=U
- QUIT
- +20 WRITE !," Primary Site Code: ",ONCAB(165.5,IEN,20.1)," "
- +21 SET TOP=$PIECE(NODE2,U,1)
- IF TOP'=""
- WRITE $PIECE(^ONCO(164,TOP,0),U,1)
- DO P
- if EX=U
- QUIT
- +22 WRITE !," Text-Primary Site Title: ",ONCAB(165.5,IEN,100)
- DO P
- if EX=U
- QUIT
- +23 IF (DATEDX>3061231)&(DATEDX<3130000)
- Begin DoDot:1
- +24 WRITE !," Mult Tum Rpt as One Prim: ",ONCAB(165.5,IEN,194,"E")
- DO P
- if EX=U
- QUIT
- +25 WRITE !," Date of Multiple Tumors: ",ONCAB(165.5,IEN,195,"E")
- DO P
- if EX=U
- QUIT
- +26 WRITE !," Multiplicity Counter: ",ONCAB(165.5,IEN,196,"E")
- DO P
- if EX=U
- QUIT
- End DoDot:1
- +27 WRITE !," Laterality: ",ONCAB(165.5,IEN,28)
- DO P
- if EX=U
- QUIT
- +28 SET HIST=$$HIST^ONCFUNC(IEN,.HSTFLD)
- +29 WRITE !," Histology: ",$GET(HIST)," ",ONCAB(165.5,IEN,HSTFLD)
- DO P
- if EX=U
- QUIT
- +30 WRITE !," Text-Histology Title: ",ONCAB(165.5,IEN,101)
- DO P
- if EX=U
- QUIT
- +31 if TOP=67619
- WRITE !," Gleason Score (Clin): ",ONCAB(165.5,IEN,623)
- +32 if TOP=67619
- WRITE !," Gleason Score (Path): ",ONCAB(165.5,IEN,250,"E")
- +33 if TOP=67619
- WRITE !," PSA: ",ONCAB(165.5,IEN,684)
- +34 if TOP=67619
- WRITE !," PSA Date: ",ONCAB(165.5,IEN,96,"E")
- +35 if TOP=67619
- WRITE !," DRE +/-: ",ONCAB(165.5,IEN,102,"E")
- +36 if TOP=67619
- WRITE !," DRE Date: ",ONCAB(165.5,IEN,156)
- +37 IF DATEDX<3180000
- WRITE !," Grade/Differentiation: ",ONCAB(165.5,IEN,24)," "
- +38 SET GR=$PIECE(NODE2,U,5)
- IF GR'=""
- WRITE $PIECE(^ONCO(164.43,GR,0),U,2)
- DO P
- if EX=U
- QUIT
- +39 IF (DATEDX>3091231)&(DATEDX<3160000)
- Begin DoDot:1
- +40 WRITE !," Grade Path System: ",ONCAB(165.5,IEN,24.1,"E")
- DO P
- if EX=U
- QUIT
- +41 WRITE !," Grade Path Value: ",ONCAB(165.5,IEN,24.2,"E")
- DO P
- if EX=U
- QUIT
- End DoDot:1
- +42 IF DATEDX>3171231
- Begin DoDot:1
- +43 WRITE !," Grade Clinical: ",ONCAB(165.5,IEN,24.3,"E")
- DO P
- if EX=U
- QUIT
- +44 WRITE !," Grade Pathological: ",ONCAB(165.5,IEN,24.4,"E")
- DO P
- if EX=U
- QUIT
- +45 WRITE !,"Grade Post Therapy Clin(yc): ",ONCAB(165.5,IEN,24.6,"E")
- DO P
- if EX=U
- QUIT
- +46 WRITE !,"Grade Post Therapy Path(yp): ",ONCAB(165.5,IEN,24.5,"E")
- DO P
- if EX=U
- QUIT
- End DoDot:1
- +47 WRITE !," AFIP/JPC Submission: ",ONCAB(165.5,IEN,83)
- DO P
- if EX=U
- QUIT
- +48 WRITE !," Diagnostic Confirmation: ",ONCAB(165.5,IEN,26)
- DO P
- if EX=U
- QUIT
- +49 if TOP=67220
- WRITE !," Hepatitis C: ",ONCAB(165.5,IEN,1010)
- +50 IF DATEDX<3040000
- Begin DoDot:1
- +51 SET TM1=$$PRINT^ONCOTM(IEN,1)
- +52 IF TM1["UMOR"
- SET $EXTRACT(TM1,2,5)="umor"
- IF TM1["ARKER"
- SET $EXTRACT(TM1,8,12)="arker"
- +53 SET TM2=$$PRINT^ONCOTM(IEN,2)
- +54 IF TM2["UMOR"
- SET $EXTRACT(TM2,2,5)="umor"
- IF TM2["ARKER"
- SET $EXTRACT(TM2,8,12)="arker"
- +55 SET TM3=$$PRINT^ONCOTM(IEN,3)
- +56 IF TM3["UMOR"
- SET $EXTRACT(TM3,2,5)="umor"
- IF TM3["ARKER"
- SET $EXTRACT(TM3,8,12)="arker"
- +57 SET LEN=$LENGTH(TM1)
- WRITE !?(27-LEN),TM1,": ",ONCAB(165.5,IEN,25.1)
- DO P
- if EX=U
- QUIT
- +58 SET LEN=$LENGTH(TM2)
- WRITE !?(27-LEN),TM2,": ",ONCAB(165.5,IEN,25.2)
- DO P
- if EX=U
- QUIT
- +59 SET LEN=$LENGTH(TM3)
- WRITE !?(27-LEN),TM3,": ",ONCAB(165.5,IEN,25.3)
- DO P
- if EX=U
- QUIT
- End DoDot:1
- +60 WRITE !," Facility Referred From: ",ONCAB(165.5,IEN,6)
- DO P
- if EX=U
- QUIT
- +61 WRITE !," Facility Referred To: ",ONCAB(165.5,IEN,7)
- DO P
- if EX=U
- QUIT
- +62 WRITE !," Fee Basis: ",ONCAB(165.5,IEN,237,"E")
- DO P
- if EX=U
- QUIT
- +63 WRITE !," Fee Basis Location: ",ONCAB(165.5,IEN,237.1,"E")
- DO P
- if EX=U
- QUIT
- +64 WRITE !,"Presentation at Cancer Conf: ",ONCAB(165.5,IEN,120)
- DO P
- if EX=U
- QUIT
- +65 WRITE !," Date of Cancer Conference: ",ONCAB(165.5,IEN,121)
- DO P
- if EX=U
- QUIT
- +66 WRITE !," Casefinding Source: ",ONCAB(165.5,IEN,21,"E")
- +67 ;
- +68 IF $EXTRACT(IOST,1,2)="C-"
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to continue with this abstract"
- DO ^DIR
- if 'Y
- QUIT
- DO HDR
- GOTO PA1A
- +69 DO P
- if EX=U
- QUIT
- PA1A DO ^ONCOPA1A
- +1 ;
- EXIT ;KILL variables
- +1 KILL CHST,CMIEN,CNTR,COC,CRA,D0,DA,DATEDX,DIC,DIQ,DIR,DOB,DR,DTE,DXDT,EX
- +2 KILL FHDT,FHIEN,FHZN,FILE,FLG,FM,FOLH,FR,GR,HIST,HSTFLD,IC,ICDCD,IEN,LEN
- +3 KILL LENGTH,LINE,NAME,NF,NODE2,NOK,NUM,ONCAB,ONCOIEN,ONCOLST,OTHPRI,PATH
- +4 KILL PATNAME,PG,POP,PRI,PRTDATE,PRTPCE,PRZN,PTIEN,QS,RCDT,REG,REG1,RK,RK1
- +5 KILL SCT,SITE,SR,SSAN,ST,STARS,TITLE,TM1,TM2,TM3,TOP,TPX,TSIEN,TSTAT,UF
- +6 KILL VRBLPTR,VS,Y,ZN
- +7 QUIT
- +8 ;
- P ;Enter RETURN to continue
- +1 IF $Y>(IOSL-10)
- Begin DoDot:1
- +2 IF $EXTRACT(IOST,1,2)="C-"
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to continue with this abstract"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +3 DO HDR
- QUIT
- End DoDot:1
- if EX=U
- QUIT
- WRITE !
- +4 QUIT
- +5 ;
- FORMAT ;
- +1 SET LENGTH=$LENGTH(NAME)
- SET NUM=(((132-LENGTH)/2)\1)-10
- +2 SET TITLE=" "_$EXTRACT(STARS,1,NUM)_" "_NAME_" "_$EXTRACT(STARS,1,NUM)
- +3 QUIT
- +4 ;
- TASK ;Report Queued
- +1 KILL ZTUCI,ZTDTH,ZTIO,ZTSAVE
- +2 SET ZTRTN="PRINT^ONCOPA1"
- SET ZTREQ="@"
- SET ZTSAVE("ZTREQ")=""
- +3 SET ZTDESC="Print Complete Abstract"
- +4 FOR RK=1:1
- SET RK1=$PIECE(ONCOLST,U,RK)
- if RK1=""
- QUIT
- SET ZTSAVE(RK1)=""
- +5 DO ^%ZTLOAD
- DO ^%ZISC
- USE IO
- WRITE !,"Report Queued",!
- +6 KILL ZTDESC,ZTREQ,ZTRTN,ZTSAVE,ZTSK
- +7 QUIT
- +8 ;
- HDR ;Header
- +1 WRITE @IOF
- SET PG=PG+1
- +2 WRITE CRA,!
- +3 WRITE ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
- +4 QUIT
- +5 ;
- MULT ;Entry point for option ABS...MA...3).
- +1 ;Also called from PCEPRT2^ONCOGEN.
- +2 IF $DATA(IO("Q"))
- SET ONCOLST="ONCOIEN^PTIEN^STARS^LENGTH^TITLE^PRTPCE^ONCODA^ESPD"
- DO TASK
- GOTO EXIT
- +3 USE IO
- DO PRINT
- KILL %ZIS,IOP
- GOTO EXIT
- +4 QUIT
- +5 ;
- CLEANUP ;Cleanup
- +1 KILL ESPD