- 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 Feb 18, 2025@23:51:36 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