ONCOPRT ;HINES OIFO/GWB - OncoTrax reports ;05/03/12
;;2.2;ONCOLOGY;**1,13**;Jul 31, 2013;Build 7
;This routine invokes Integration Agreement #3151
;add to suspense if Disease Index for Casefinding is not already in suspense
SUS ;[SP Print Suspense List by Suspense Date (132c)]
S BY="@75,INTERNAL(#3),@75,.01,75,2;C2"
S (FR,TO)=DUZ(2)_",?"
S FLDS="[ONCO SUSPENSE]"
G PRT60
;
DI ;[DI Disease Index]
;Supported by IA #3151
S (COUNT,SUSCOUNT)=0
S OSPIEN=$O(^ONCO(160.1,"C",DUZ(2),0))
S AFLDIV=""
I $O(^ONCO(160.1,OSPIEN,6,0)) D
.S ADIEN=0 F S ADIEN=$O(^ONCO(160.1,OSPIEN,6,ADIEN)) Q:ADIEN'>0 S AFLDIV=AFLDIV_^ONCO(160.1,OSPIEN,6,ADIEN,0)_U
W !
K DIR
S DIR(0)="SAO^1:Casefinding;2:Customized search"
S DIR("A")=" Select DISEASE INDEX report: "
S DIR("?",1)=" Select 'Casefinding' if you want to find and add to SUSPENSE"
S DIR("?",2)=" cases with reportable tumors for the selected date range."
S DIR("?",3)=""
S DIR("?",4)=" Select 'Customized search' if you want to search for an"
S DIR("?",5)=" individual ICD-CM code or range of codes."
S DIR("?")=" "
D ^DIR
I $D(DIRUT) K DIRUT Q
I Y<1 Q
I +Y=1 S (SORT,BY)="[ONC DISEASE INDEX CASEFINDING]"
I +Y=2 S (SORT,BY)="[ONC DISEASE INDEX]"
S DIC="^AUPNVPOV(",L=0
S FLDS="[ONC DISEASE INDEX]"
S DIS(0)="I $$DIDIV^ONCFUNC(D0)=""Y"""
;sets the ICD screens
D ICD^ONCOPRT1
;
S DHIT="S SAVED0=D0 D DISUS^ONCOPRT S D0=SAVED0"
I SORT="[ONC DISEASE INDEX CASEFINDING]" S DIOEND="W !?6,""-----"",!,""COUNT "",COUNT,!,""Added to SUSPENSE "",SUSCOUNT"
E S DIOEND="W !?6,""-----"",!,""COUNT "",COUNT"
D EN1^DIP
K AFLDIV,ADIEN,COUNT,D0,DHIT,DIOEND,DIR,DR,ONCSUB,OSPIEN,POV,SAVED0,SORT,SUSCOUNT
G EX
;
DISUS ;Add DISEASE INDEX case to suspense
N DA,DC,DIC,DPTIEN,ICD,ONCS,ONCDIV,ONCIEN,ONCPAT,X
S ICD=$P(^AUPNVPOV(D0,0),U,1)
S DPTIEN=$P(^AUPNVPOV(D0,0),U,2)
I '$D(POV(DPTIEN)) S COUNT=COUNT+1,POV(DPTIEN)=""
;Q:SORT="[ONC DISEASE INDEX]" ;comment this for v2.2
S ONCPAT=DPTIEN_";DPT("
S ONCIEN=$O(^ONCO(160,"B",ONCPAT,0))
I ONCIEN'>0 D
.K DO
.S DIC="^ONCO(160,",DIC(0)="Z"
.S X=ONCPAT
.D FILE^DICN
.K DO
.S ONCIEN=+Y
S ONCDIV="",ONCS=""
F S ONCS=$O(^ONCO(160,ONCIEN,"SUS","C",ONCS)) Q:ONCS'>0 S ONCDIV=ONCDIV_U_ONCS
I ONCDIV[DUZ(2) Q
S DA(1)=ONCIEN
S DIC="^ONCO(160,"_DA(1)_",""SUS"","
K DO
S DIC(0)="L"
S DIC("P")=$P(^DD(160,75,0),U,2)
S X=$$GET1^DIQ(9000010,$$GET1^DIQ(9000010.07,D0,.03,"I"),.01,"I")
S X=$P(X,".",1)
D FILE^DICN
K DO,DIE
S DA(1)=ONCIEN
S DIE="^ONCO(160,"_DA(1)_",""SUS"","
S (ONCSUB,DA)=+Y
S DR="1///^S X=DT;2///^S X=""DI"";3////^S X=DUZ(2);8////^S X=ICD"
D ^DIE
S SUSCOUNT=SUSCOUNT+1
Q
;
DNP ;[NP Oncology Patient List-NO Primaries/Suspense]
S BY="@75,INTERNAL(#3),@NO PRIMARY;L1,NAME"
S (FR,TO)=DUZ(2)
S FLDS="[ONCO PATIENT ONLY]"
G PRT60
;
ABI ;[NC Print Abstract NOT Complete List]
W !
N BY,FLDS,FR,DIR,DIS,TO,Y
K DIR
S DIR(0)="SAO^1:Date Dx;2:Date of First Contact"
S DIR("A")=" Select date field to be used for sorting: "
S DIR("?")="Select the date field you wish to use for sorting this report."
D ^DIR
I $D(DIRUT) K DIRUT Q
I Y<1 S OUT=1 Q
I +Y=1 S BY="#+91,@INTERNAL(#3)"
I +Y=2 S BY="#+91,@INTERNAL(#155)"
S FR=",@"
S TO=""
S FLDS="[ONCO ABSTRACT NOT-COMPLETE]"
S DIS(0)="I $P($G(^ONCO(165.5,D0,7)),U,2)'=3"
G PRT655
;
PFH ;[FH Patient Follow-up History]
D PAT I Y'<0 D G EX
.S BY="@NUMBER"
.S (FR,TO)=+Y
.S FLDS="[ONCO FOLLOWUP HISTORY]"
.D PRT60
Q
;
DUF ;[DF Print Due Follow-up List by Month Due]
W ! N BY,FLDS,DIR,DIS,Y
N ONCDFL
D DIR
I $D(DIRUT) K DIRUT Q
I Y<1 Q
S DIC("B")=2004
I +Y=1 S (BY,FLDS)="[ONCO DUE FOLLOWUP]"
I +Y=2 S BY="[ONCO DUE FOLLOWUP]",FLDS="[ONCO DUE FOLLOWUP2]"
S DIS(0)="I $$PFTD^ONCOPRT(D0)=""Y"""
G PRT60
;
DEL ;[LF Print Delinquent (LTF) List]
N BY,FLDS,DIR,DIS,Y
N ONCDFL
W !!?5,"FOLLOW-UP STATUS will be changed from ""Active"" to ""LTF""."
W !?5,"After 15 months the patient is considered LOST TO FOLLOW-UP."
W !
D DIR
I $D(DIRUT) K DIRUT Q
I Y<1 Q
S DIC("B")=2004
I +Y=1 S (BY,FLDS)="[ONCO DELINQUENT(LTF) LIST]"
I +Y=2 S BY="[ONCO DELINQUENT(LTF) LIST]",FLDS="[ONCO DELINQUENT(LTF) LIST2]"
S DIS(0)="I $$PFTD^ONCOPRT(D0)=""Y"""
G PRT60
;
PFTD(IEN) ;DTDX before 2004 not included in followup
N PFTD,PRI,ONCDT
S PFTD="N"
S PRI=0 F S PRI=$O(^ONCO(165.5,"C",IEN,PRI)) Q:PRI'>0 I $P($G(^ONCO(165.5,PRI,"DIV")),U,1)=DUZ(2) D
.S ONCDT=$P($G(^ONCO(165.5,PRI,0)),U,16)
.I ONCDT<3040101 S PFTD="N" Q
.S PFTD="Y"
Q PFTD
;
DIR ;DIR
K DIR
S DIR(0)="SAO^1:Standard format;2:Remote employees format"
S DIR("A")=" Select report format: "
S DIR("?")="Select the report format you wish to use for this report."
D ^DIR
Q
;
FST ;[SR Follow-up Status Report by Patient (132c)]
W ! S (BY,FLDS)="[ONCO FOLLOWUP STATUS RPT]"
S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
G PRT60
;
PFR ;[FR Individual Follow-up Report]
D PAT I Y'<0 D G EX
.S BY="@NUMBER"
.S (FR,TO)=+Y
.S FLDS="[ONCO FOLLOWUP PATIENT RPT]"
.D PRT60
Q
;
ACOS80 ;[AA Accession Register-ACOS (80c)]
S (BY,FLDS)="[ONCO ACCREG-ACOS80]" D HA G PRT655
;
AC80ST ;[AS Accession Register-Site (80c)]
S (BY,FLDS)="[ONCO ACCREG-SITE/GP80]" D HA G PRT655
;
EOAC ;[AE Accession Register-EOVA (132c)]
S (BY,FLDS)="[ONCO ACCREG-EOVA132]" D HA G PRT655
;
HA ;Help for Accession Registers
W !!?3,"For a complete register:"
W !?5,"START WITH ACC/SEQ NUMBER: FIRST// <Enter>"
W !!?3,"For a single accession year (e.g. 1999):"
W !,?5,"START WITH ACC/SEQ NUMBER: FIRST// 1999-00000"
W !,?5,"GO TO ACC/SEQ NUMBER: LAST// 1999-99999"
W !!?3,"For a single patient (e.g. 1999-00001):"
W !,?5,"START WITH ACC/SEQ NUMBER: FIRST// 1999-00001/00"
W !,?5,"GO TO ACC/SEQ NUMBER: LAST// 1999-00001/99"
W !
Q
;
ACOSPT ;[PA Patient Index-ACOS (132c)]
S BY="NAME",(FR,TO)=""
S FLDS="[ONCO PATIENT INDX-ACOS]"
S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
G PRT60
;
PAT80 ;[PS Patient Index-Site (80c)]
S BY="NAME"
S (FR,TO)=""
S FLDS="[ONCO PATIENT INDX80]"
S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
G PRT60
;
EOVA ;[PE Patient Index-EOVA (132c)]
S BY="NAME"
S (FR,TO)=""
S FLDS="[ONCO PATIENT INDX-EOVA132]"
S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
G PRT60
;
ICD80 ;[IN Primary ICDO Listing (80c)]
S (BY,FLDS)="[ONCO ICDO-SITE80]"
G PRT655
;
SIT80 ;[SG Primary Site/GP Listing (80c)]
S (BY,FLDS)="[ONCO SITE/GP80]"
G PRT655
;
ICD132 ;[IW Primary ICDO Listing (132c)]
S (BY,FLDS)="[ONCO ICDO-SITE132]"
G PRT655
;
PAT ;ONCOLOGY PATIENT (160) lookup
W !
S DIC="^ONCO(160,",DIC(0)="AEQM",DIC("A")=" Select Patient Name: "
D ^DIC K DIC W !
Q
;
PRT60 ;Print ONCOLOGY PATIENT (160) file
S DIC="^ONCO(160,",L=0 D EN1^DIP G EX
;
PRT655 ;Print ONCOLOGY PRIMARY (165.5) file
S DIC="^ONCO(165.5,",L=0 D EN1^DIP G EX
;
EX ;Exit
K BY,DIC,DHD,DIS,FLDS,FR,L,TO,Y
Q
;
CLEANUP ;Cleanup
K OUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPRT 7015 printed Oct 16, 2024@18:26:05 Page 2
ONCOPRT ;HINES OIFO/GWB - OncoTrax reports ;05/03/12
+1 ;;2.2;ONCOLOGY;**1,13**;Jul 31, 2013;Build 7
+2 ;This routine invokes Integration Agreement #3151
+3 ;add to suspense if Disease Index for Casefinding is not already in suspense
SUS ;[SP Print Suspense List by Suspense Date (132c)]
+1 SET BY="@75,INTERNAL(#3),@75,.01,75,2;C2"
+2 SET (FR,TO)=DUZ(2)_",?"
+3 SET FLDS="[ONCO SUSPENSE]"
+4 GOTO PRT60
+5 ;
DI ;[DI Disease Index]
+1 ;Supported by IA #3151
+2 SET (COUNT,SUSCOUNT)=0
+3 SET OSPIEN=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
+4 SET AFLDIV=""
+5 IF $ORDER(^ONCO(160.1,OSPIEN,6,0))
Begin DoDot:1
+6 SET ADIEN=0
FOR
SET ADIEN=$ORDER(^ONCO(160.1,OSPIEN,6,ADIEN))
if ADIEN'>0
QUIT
SET AFLDIV=AFLDIV_^ONCO(160.1,OSPIEN,6,ADIEN,0)_U
End DoDot:1
+7 WRITE !
+8 KILL DIR
+9 SET DIR(0)="SAO^1:Casefinding;2:Customized search"
+10 SET DIR("A")=" Select DISEASE INDEX report: "
+11 SET DIR("?",1)=" Select 'Casefinding' if you want to find and add to SUSPENSE"
+12 SET DIR("?",2)=" cases with reportable tumors for the selected date range."
+13 SET DIR("?",3)=""
+14 SET DIR("?",4)=" Select 'Customized search' if you want to search for an"
+15 SET DIR("?",5)=" individual ICD-CM code or range of codes."
+16 SET DIR("?")=" "
+17 DO ^DIR
+18 IF $DATA(DIRUT)
KILL DIRUT
QUIT
+19 IF Y<1
QUIT
+20 IF +Y=1
SET (SORT,BY)="[ONC DISEASE INDEX CASEFINDING]"
+21 IF +Y=2
SET (SORT,BY)="[ONC DISEASE INDEX]"
+22 SET DIC="^AUPNVPOV("
SET L=0
+23 SET FLDS="[ONC DISEASE INDEX]"
+24 SET DIS(0)="I $$DIDIV^ONCFUNC(D0)=""Y"""
+25 ;sets the ICD screens
+26 DO ICD^ONCOPRT1
+27 ;
+28 SET DHIT="S SAVED0=D0 D DISUS^ONCOPRT S D0=SAVED0"
+29 IF SORT="[ONC DISEASE INDEX CASEFINDING]"
SET DIOEND="W !?6,""-----"",!,""COUNT "",COUNT,!,""Added to SUSPENSE "",SUSCOUNT"
+30 IF '$TEST
SET DIOEND="W !?6,""-----"",!,""COUNT "",COUNT"
+31 DO EN1^DIP
+32 KILL AFLDIV,ADIEN,COUNT,D0,DHIT,DIOEND,DIR,DR,ONCSUB,OSPIEN,POV,SAVED0,SORT,SUSCOUNT
+33 GOTO EX
+34 ;
DISUS ;Add DISEASE INDEX case to suspense
+1 NEW DA,DC,DIC,DPTIEN,ICD,ONCS,ONCDIV,ONCIEN,ONCPAT,X
+2 SET ICD=$PIECE(^AUPNVPOV(D0,0),U,1)
+3 SET DPTIEN=$PIECE(^AUPNVPOV(D0,0),U,2)
+4 IF '$DATA(POV(DPTIEN))
SET COUNT=COUNT+1
SET POV(DPTIEN)=""
+5 ;Q:SORT="[ONC DISEASE INDEX]" ;comment this for v2.2
+6 SET ONCPAT=DPTIEN_";DPT("
+7 SET ONCIEN=$ORDER(^ONCO(160,"B",ONCPAT,0))
+8 IF ONCIEN'>0
Begin DoDot:1
+9 KILL DO
+10 SET DIC="^ONCO(160,"
SET DIC(0)="Z"
+11 SET X=ONCPAT
+12 DO FILE^DICN
+13 KILL DO
+14 SET ONCIEN=+Y
End DoDot:1
+15 SET ONCDIV=""
SET ONCS=""
+16 FOR
SET ONCS=$ORDER(^ONCO(160,ONCIEN,"SUS","C",ONCS))
if ONCS'>0
QUIT
SET ONCDIV=ONCDIV_U_ONCS
+17 IF ONCDIV[DUZ(2)
QUIT
+18 SET DA(1)=ONCIEN
+19 SET DIC="^ONCO(160,"_DA(1)_",""SUS"","
+20 KILL DO
+21 SET DIC(0)="L"
+22 SET DIC("P")=$PIECE(^DD(160,75,0),U,2)
+23 SET X=$$GET1^DIQ(9000010,$$GET1^DIQ(9000010.07,D0,.03,"I"),.01,"I")
+24 SET X=$PIECE(X,".",1)
+25 DO FILE^DICN
+26 KILL DO,DIE
+27 SET DA(1)=ONCIEN
+28 SET DIE="^ONCO(160,"_DA(1)_",""SUS"","
+29 SET (ONCSUB,DA)=+Y
+30 SET DR="1///^S X=DT;2///^S X=""DI"";3////^S X=DUZ(2);8////^S X=ICD"
+31 DO ^DIE
+32 SET SUSCOUNT=SUSCOUNT+1
+33 QUIT
+34 ;
DNP ;[NP Oncology Patient List-NO Primaries/Suspense]
+1 SET BY="@75,INTERNAL(#3),@NO PRIMARY;L1,NAME"
+2 SET (FR,TO)=DUZ(2)
+3 SET FLDS="[ONCO PATIENT ONLY]"
+4 GOTO PRT60
+5 ;
ABI ;[NC Print Abstract NOT Complete List]
+1 WRITE !
+2 NEW BY,FLDS,FR,DIR,DIS,TO,Y
+3 KILL DIR
+4 SET DIR(0)="SAO^1:Date Dx;2:Date of First Contact"
+5 SET DIR("A")=" Select date field to be used for sorting: "
+6 SET DIR("?")="Select the date field you wish to use for sorting this report."
+7 DO ^DIR
+8 IF $DATA(DIRUT)
KILL DIRUT
QUIT
+9 IF Y<1
SET OUT=1
QUIT
+10 IF +Y=1
SET BY="#+91,@INTERNAL(#3)"
+11 IF +Y=2
SET BY="#+91,@INTERNAL(#155)"
+12 SET FR=",@"
+13 SET TO=""
+14 SET FLDS="[ONCO ABSTRACT NOT-COMPLETE]"
+15 SET DIS(0)="I $P($G(^ONCO(165.5,D0,7)),U,2)'=3"
+16 GOTO PRT655
+17 ;
PFH ;[FH Patient Follow-up History]
+1 DO PAT
IF Y'<0
Begin DoDot:1
+2 SET BY="@NUMBER"
+3 SET (FR,TO)=+Y
+4 SET FLDS="[ONCO FOLLOWUP HISTORY]"
+5 DO PRT60
End DoDot:1
GOTO EX
+6 QUIT
+7 ;
DUF ;[DF Print Due Follow-up List by Month Due]
+1 WRITE !
NEW BY,FLDS,DIR,DIS,Y
+2 NEW ONCDFL
+3 DO DIR
+4 IF $DATA(DIRUT)
KILL DIRUT
QUIT
+5 IF Y<1
QUIT
+6 SET DIC("B")=2004
+7 IF +Y=1
SET (BY,FLDS)="[ONCO DUE FOLLOWUP]"
+8 IF +Y=2
SET BY="[ONCO DUE FOLLOWUP]"
SET FLDS="[ONCO DUE FOLLOWUP2]"
+9 SET DIS(0)="I $$PFTD^ONCOPRT(D0)=""Y"""
+10 GOTO PRT60
+11 ;
DEL ;[LF Print Delinquent (LTF) List]
+1 NEW BY,FLDS,DIR,DIS,Y
+2 NEW ONCDFL
+3 WRITE !!?5,"FOLLOW-UP STATUS will be changed from ""Active"" to ""LTF""."
+4 WRITE !?5,"After 15 months the patient is considered LOST TO FOLLOW-UP."
+5 WRITE !
+6 DO DIR
+7 IF $DATA(DIRUT)
KILL DIRUT
QUIT
+8 IF Y<1
QUIT
+9 SET DIC("B")=2004
+10 IF +Y=1
SET (BY,FLDS)="[ONCO DELINQUENT(LTF) LIST]"
+11 IF +Y=2
SET BY="[ONCO DELINQUENT(LTF) LIST]"
SET FLDS="[ONCO DELINQUENT(LTF) LIST2]"
+12 SET DIS(0)="I $$PFTD^ONCOPRT(D0)=""Y"""
+13 GOTO PRT60
+14 ;
PFTD(IEN) ;DTDX before 2004 not included in followup
+1 NEW PFTD,PRI,ONCDT
+2 SET PFTD="N"
+3 SET PRI=0
FOR
SET PRI=$ORDER(^ONCO(165.5,"C",IEN,PRI))
if PRI'>0
QUIT
IF $PIECE($GET(^ONCO(165.5,PRI,"DIV")),U,1)=DUZ(2)
Begin DoDot:1
+4 SET ONCDT=$PIECE($GET(^ONCO(165.5,PRI,0)),U,16)
+5 IF ONCDT<3040101
SET PFTD="N"
QUIT
+6 SET PFTD="Y"
End DoDot:1
+7 QUIT PFTD
+8 ;
DIR ;DIR
+1 KILL DIR
+2 SET DIR(0)="SAO^1:Standard format;2:Remote employees format"
+3 SET DIR("A")=" Select report format: "
+4 SET DIR("?")="Select the report format you wish to use for this report."
+5 DO ^DIR
+6 QUIT
+7 ;
FST ;[SR Follow-up Status Report by Patient (132c)]
+1 WRITE !
SET (BY,FLDS)="[ONCO FOLLOWUP STATUS RPT]"
+2 SET DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
+3 GOTO PRT60
+4 ;
PFR ;[FR Individual Follow-up Report]
+1 DO PAT
IF Y'<0
Begin DoDot:1
+2 SET BY="@NUMBER"
+3 SET (FR,TO)=+Y
+4 SET FLDS="[ONCO FOLLOWUP PATIENT RPT]"
+5 DO PRT60
End DoDot:1
GOTO EX
+6 QUIT
+7 ;
ACOS80 ;[AA Accession Register-ACOS (80c)]
+1 SET (BY,FLDS)="[ONCO ACCREG-ACOS80]"
DO HA
GOTO PRT655
+2 ;
AC80ST ;[AS Accession Register-Site (80c)]
+1 SET (BY,FLDS)="[ONCO ACCREG-SITE/GP80]"
DO HA
GOTO PRT655
+2 ;
EOAC ;[AE Accession Register-EOVA (132c)]
+1 SET (BY,FLDS)="[ONCO ACCREG-EOVA132]"
DO HA
GOTO PRT655
+2 ;
HA ;Help for Accession Registers
+1 WRITE !!?3,"For a complete register:"
+2 WRITE !?5,"START WITH ACC/SEQ NUMBER: FIRST// <Enter>"
+3 WRITE !!?3,"For a single accession year (e.g. 1999):"
+4 WRITE !,?5,"START WITH ACC/SEQ NUMBER: FIRST// 1999-00000"
+5 WRITE !,?5,"GO TO ACC/SEQ NUMBER: LAST// 1999-99999"
+6 WRITE !!?3,"For a single patient (e.g. 1999-00001):"
+7 WRITE !,?5,"START WITH ACC/SEQ NUMBER: FIRST// 1999-00001/00"
+8 WRITE !,?5,"GO TO ACC/SEQ NUMBER: LAST// 1999-00001/99"
+9 WRITE !
+10 QUIT
+11 ;
ACOSPT ;[PA Patient Index-ACOS (132c)]
+1 SET BY="NAME"
SET (FR,TO)=""
+2 SET FLDS="[ONCO PATIENT INDX-ACOS]"
+3 SET DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
+4 GOTO PRT60
+5 ;
PAT80 ;[PS Patient Index-Site (80c)]
+1 SET BY="NAME"
+2 SET (FR,TO)=""
+3 SET FLDS="[ONCO PATIENT INDX80]"
+4 SET DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
+5 GOTO PRT60
+6 ;
EOVA ;[PE Patient Index-EOVA (132c)]
+1 SET BY="NAME"
+2 SET (FR,TO)=""
+3 SET FLDS="[ONCO PATIENT INDX-EOVA132]"
+4 SET DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
+5 GOTO PRT60
+6 ;
ICD80 ;[IN Primary ICDO Listing (80c)]
+1 SET (BY,FLDS)="[ONCO ICDO-SITE80]"
+2 GOTO PRT655
+3 ;
SIT80 ;[SG Primary Site/GP Listing (80c)]
+1 SET (BY,FLDS)="[ONCO SITE/GP80]"
+2 GOTO PRT655
+3 ;
ICD132 ;[IW Primary ICDO Listing (132c)]
+1 SET (BY,FLDS)="[ONCO ICDO-SITE132]"
+2 GOTO PRT655
+3 ;
PAT ;ONCOLOGY PATIENT (160) lookup
+1 WRITE !
+2 SET DIC="^ONCO(160,"
SET DIC(0)="AEQM"
SET DIC("A")=" Select Patient Name: "
+3 DO ^DIC
KILL DIC
WRITE !
+4 QUIT
+5 ;
PRT60 ;Print ONCOLOGY PATIENT (160) file
+1 SET DIC="^ONCO(160,"
SET L=0
DO EN1^DIP
GOTO EX
+2 ;
PRT655 ;Print ONCOLOGY PRIMARY (165.5) file
+1 SET DIC="^ONCO(165.5,"
SET L=0
DO EN1^DIP
GOTO EX
+2 ;
EX ;Exit
+1 KILL BY,DIC,DHD,DIS,FLDS,FR,L,TO,Y
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL OUT
