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