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