Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOPRT

ONCOPRT.m

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