ONCOCFR ;HINES OIFO/GWB - RADIOLOGY CASEFINDING ;05/07/12
;;2.2;ONCOLOGY;**1,17,20**;Jul 31, 2013;Build 5
;P20
ST ;Start RAD/NUC MED PATIENT (70) file search
W @IOF
W !!!?10,"******** RADIOLOGY: SUSPICIOUS MALIGNANCY SEARCH ********",!
W !?10,"This option will search the RAD/NUC MED PATIENT file"
W !?10,"for cases to add to the Suspense List."
MG S MG=0,D0=0 F S D0=$O(^RA(78.3,"B",D0)) Q:D0="" S XX=$TR(D0,"malig","MALIG") I XX["MALIG" S MG=$O(^(D0,0)) Q
G T:MG W !!?15,"MALIGNACY diagnostic code is not defined in the"
W !?15,"Radiology Diagnostic Codes File (#78.3). Please"
W !?15,"REQUEST Radiology to code suspicious MALIGNANCIES"
W !!!?10,"MUST terminate Radiology Search - no meaningful search code" G EX
;
T ;Start Date/End Date
S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
I OSP="" D Q
.W !!?10,"Casefinding requires an ONCOLOGY SITE PARAMETER"
.W !?10,"entry which matches the user's login DIVISION."
.W !?10,"There is no ONCOLOGY SITE PARAMETER for DIVISION:"
.W !?10,$P($G(^DIC(4,DUZ(2),0)),U,1)
S Y=$P(^ONCO(160.1,OSP,0),U,6)
I Y="" S Y=DT
S Y=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
K DIR
S DIR("B")=Y
W !
S DIR("A")=" Start Date",DIR(0)="D" D ^DIR
G EX:Y<1!(Y[U)
S (SD,X)=Y D DD^%DT W " ",Y S WSD=Y
K DIR
S DIR("A")=" End Date",DIR(0)="D" D ^DIR
G EX:Y=""!(Y[U)
I Y<SD!(Y>DT) W *7,?40,"Invalid date sequence!!",! G T
S $P(^ONCO(160.1,OSP,0),U,6)=Y
S (ED,X)=Y D DD^%DT W " ",Y,!
S WED=Y
S DIR("A")=" Dates OK",DIR("B")="Y",DIR(0)="Y" D ^DIR
G T:'Y,EX:Y[U!(Y="")
W !!?15,"We will find suspicious malignancies"
W !?15,"From: ",WSD_" To: "_WED,!
W ! S ONCO("SD")=SD,ONCO("ED")=ED,ONCO("MG")=MG
;
TSK ;Create task
K IO("Q") S %ZIS="Q" D ^%ZIS I POP S ONCOUT="" G EX
I '$D(IO("Q")) D SER^ONCOCFR G EX
S ZTRTN="SER^ONCOCFR",ZTSAVE("ONCO*")="",ZTDESC="ONCOLOGY RADIOLOGY SEARCH" D ^%ZTLOAD G EX
;
SER ;Search RAD/NUC MED PATIENT (70) file/Set multidivisional variables
S AFFDIV=$G(DUZ(2)),ONCDIVSP=$O(^ONCO(160.1,"C",AFFDIV,""))
I ONCDIVSP="" W !!,"User does not have an associated DIVISION!",!! G EX
F Z=0:0 S Z=$O(^ONCO(160.1,ONCDIVSP,6,Z)) Q:Z'>0 S AFFDIV=AFFDIV_U_$G(^ONCO(160.1,ONCDIVSP,6,Z,0))
K ^TMP("ONCO",$J) S (XSD,XDT)=ONCO("SD")-.1111111,XED=ONCO("ED")+.9999999,MG=ONCO("MG") F J=0,1,2 S ^TMP("ONCO",$J,J)=0
F S XDT=$O(^RADPT("AR",XDT)) Q:XDT=""!(XDT>XED) S D0=0 F S D0=$O(^RADPT("AR",XDT,D0)) Q:D0'>0 S D1=$O(^RADPT("AR",XDT,D0,0)) D
.S D2=0 F S D2=$O(^RADPT(D0,"DT",D1,"P",D2)) Q:D2'>0 D
..S RA0=$G(^(D2,0)) I RA0="" Q
..S PC13=$P(RA0,U,13) I PC13="" Q
..;S EXP=$$GET1^DIQ(78.3,PC13,6),EXP=$TR(EXP,"malig","MALIG"),EXP=$TR(EXP,"Suspicious","SUSPICIOUS")
..;S MG=$P($G(^RA(78.3,PC13,0)),U,1),MG=$TR(MG,"malig","MALIG"),MG=$TR(MG,"cancer","CANCER")
..S EXP=$$GET1^DIQ(78.3,PC13,6),EXP=$TR(EXP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
..S MG=$P($G(^RA(78.3,PC13,0)),U,1),MG=$TR(MG,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
..I (MG["MALIG")!(MG["CANCER")!(EXP["MALIG") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..I (MG["BLASTOMA")!(MG["CARCINOMA")!(MG["GLIOMA") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..I (MG["ACOUSTIC NEUROMA")!(MG["ASTROCYTOMA")!(MG["CARCINOID") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..I (MG["DCIS")!(MG["HCC")!(MG["HODGKIN") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..I (MG["IPNM")!(MG["LYMPHOMA")!(MG["MENINGIOMA") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..I (MG["MESOTHELIOMA")!(MG["METASTA")!(MG["PITUITARY ADENOMA") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..I (MG["SARCOMA")!(MG["SCHWANNOMA")!(MG["TUMOR") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
..S D3=0 F S D3=$O(^RADPT(D0,"DT",D1,"P",D2,"DX",D3)) Q:D3'>0 D
...S RASDC0=$G(^(D3,0)) I RASDC0="" Q
...S PC1=$P(RASDC0,U,1) I PC1="" Q
...;S EXP=$$GET1^DIQ(78.3,PC1,6),EXP=$TR(EXP,"malig","MALIG"),EXP=$TR(EXP,"Suspicious","SUSPICIOUS")
...;S MG=$P($G(^RA(78.3,PC1,0)),U,1),MG=$TR(MG,"malig","MALIG"),MG=$TR(MG,"cancer","CANCER")
...S EXP=$$GET1^DIQ(78.3,PC1,6),EXP=$TR(EXP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
...S MG=$P($G(^RA(78.3,PC1,0)),U,1),MG=$TR(MG,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
...I (MG["MALIG")!(MG["CANCER")!(EXP["MALIG") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
...I (MG["BLASTOMA")!(MG["CARCINOMA")!(MG["GLIOMA") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
...I (MG["ACOUSTIC NEUROMA")!(MG["ASTROCYTOMA")!(MG["CARCINOID") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
...I (MG["DCIS")!(MG["HCC")!(MG["HODGKIN") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
...I (MG["IPMN")!(MG["LYMPHOMA")!(MG["MENINGIOMA") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
...I (MG["MESOTHELIOMA")!(MG["METASTA")!(MG["PITUITARY ADENOMA") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
...I (MG["SARCOMA")!(MG["SCHWANNOMA")!(MG["TUMOR") S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
;
CK ;Check ONCOLOGY PATIENT (160) file
GT S XX=0 F S XX=$O(RA(XX)) Q:XX="" D
.D DIV Q:DVMTCH=0
.S ^TMP("ONCO",$J,0)=^TMP("ONCO",$J,0)+1
.S HT=0,X=XX_";DPT("
.S XDT=$P(RA(XX),U),XD0=$O(^ONCO(160,"B",X,0)),ONCIEN=XD0
.I XD0="" D MR Q
.I XD0'="" S ONCDIVS="",ONCS="" F S ONCS=$O(^ONCO(160,XD0,"SUS","C",ONCS)) Q:ONCS'>0 S ONCDIVS=ONCDIVS_U_ONCS
.I ONCDIVS'[DUZ(2) D
..S (D0,DA)=XD0 I '$D(^ONCO(165.5,"C",XD0)) D N2 Q
..I $D(^ONCO(165.5,"C",XD0)) D CKP I 'HT D N2 Q
.Q
;
RPT ; Generate report
I $G(^TMP("ONCO",$J,2))=0 S DIC="^ONCO(160.1,",BY="[ONCO NEG-REPORT]"
E D
.S DIC="^ONCO(160,"
.S BY="@75,INTERNAL(#3),75,.01"
.S FR=DUZ(2)_","_ONCO("SD"),TO=DUZ(2)_","_ONCO("ED")
.S FLDS="[ONCO RAD-CASEFINDING RPT]"
.Q
;
PRT ; Call print routine
S L=0,IOP=ION,DIOEND="D WP^ONCOCFR"
D EN1^DIP G EX
;
WP ; Wrap-up report
W !!!?30,"RADIOLOGY CASEFINDING RESULTS"
W !!?30,^TMP("ONCO",$J,0)_" Cases found",!?30,^TMP("ONCO",$J,1)_" New Patients added",!?30,^TMP("ONCO",$J,2)_" New cases added",!!
Q
;
CKP ;CHECK Primary File
S XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
.S XDX=$P($G(^ONCO(165.5,XD1,0)),U,16) I XDX=XDT S HT=1 Q
.S XDX=$P($G(^ONCO(165.5,XD1,1)),U,10) I XDX=XDT S HT=1 Q
.Q
Q
;
MR ;Create new ONCOLOGY PATIENT (160) record
S DIC="^ONCO(160,",DIC(0)="Z" D FILE^DICN S (ONCIEN,D0,DA)=+Y,^TMP("ONCO",$J,1)=^TMP("ONCO",$J,1)+1
N2 ;Create new SUSPENSE (160,75) record
K DD,DO
S DA(1)=ONCIEN,DIC="^ONCO(160,"_DA(1)_",""SUS"","
S DIC(0)="L",DIC("P")=$P(^DD(160,75,0),U,2),X=XDT
D FILE^DICN
K DIE S DA(1)=ONCIEN,DIE="^ONCO(160,"_DA(1)_",""SUS"","
S (ONCSUB,DA)=+Y,RDP=$P(RA(XX),U,2)
S DR="1///^S X=DT;2///^S X=""RA"";3////^S X=DUZ(2);6////^S X=RDP" D ^DIE
S ^TMP("ONCO",$J,2)=^TMP("ONCO",$J,2)+1
Q
;
DIV ;Division match
S DVMTCH=1,INST="",RE1=$P(RA(XX),U,3) I RE1="" Q
S INST=$P($G(^RADPT(XX,"DT",RE1,0)),U,3) I INST="" Q
I AFFDIV'[INST S DVMTCH=0 Q
Q
;
EX ;EXIT
K %ZIS,AFFDIV,BY,D0,D1,D2,D3,DA,DIC,DIOEND,DR,DVMTCH,ED,EXP,FLDS,FR,HT
K INST,IOP,J,L,MG,ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCOUT,ONCS,ONCSUB,OSP
K PC1,PC13,POP,RA,RA0,RASDC0,RDP,RE1,SD,TO,WED,WSD,X,XD0,XD1,XDT,XDX
K XED,XSD,XX,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ONCDIVSP
K ^TMP("ONCO",$J)
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCFR 7446 printed Dec 13, 2024@02:24:33 Page 2
ONCOCFR ;HINES OIFO/GWB - RADIOLOGY CASEFINDING ;05/07/12
+1 ;;2.2;ONCOLOGY;**1,17,20**;Jul 31, 2013;Build 5
+2 ;P20
ST ;Start RAD/NUC MED PATIENT (70) file search
+1 WRITE @IOF
+2 WRITE !!!?10,"******** RADIOLOGY: SUSPICIOUS MALIGNANCY SEARCH ********",!
+3 WRITE !?10,"This option will search the RAD/NUC MED PATIENT file"
+4 WRITE !?10,"for cases to add to the Suspense List."
MG SET MG=0
SET D0=0
FOR
SET D0=$ORDER(^RA(78.3,"B",D0))
if D0=""
QUIT
SET XX=$TRANSLATE(D0,"malig","MALIG")
IF XX["MALIG"
SET MG=$ORDER(^(D0,0))
QUIT
+1 if MG
GOTO T
WRITE !!?15,"MALIGNACY diagnostic code is not defined in the"
+2 WRITE !?15,"Radiology Diagnostic Codes File (#78.3). Please"
+3 WRITE !?15,"REQUEST Radiology to code suspicious MALIGNANCIES"
+4 WRITE !!!?10,"MUST terminate Radiology Search - no meaningful search code"
GOTO EX
+5 ;
T ;Start Date/End Date
+1 SET OSP=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
+2 IF OSP=""
Begin DoDot:1
+3 WRITE !!?10,"Casefinding requires an ONCOLOGY SITE PARAMETER"
+4 WRITE !?10,"entry which matches the user's login DIVISION."
+5 WRITE !?10,"There is no ONCOLOGY SITE PARAMETER for DIVISION:"
+6 WRITE !?10,$PIECE($GET(^DIC(4,DUZ(2),0)),U,1)
End DoDot:1
QUIT
+7 SET Y=$PIECE(^ONCO(160.1,OSP,0),U,6)
+8 IF Y=""
SET Y=DT
+9 SET Y=$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_($EXTRACT(Y,1,3)+1700)
+10 KILL DIR
+11 SET DIR("B")=Y
+12 WRITE !
+13 SET DIR("A")=" Start Date"
SET DIR(0)="D"
DO ^DIR
+14 if Y<1!(Y[U)
GOTO EX
+15 SET (SD,X)=Y
DO DD^%DT
WRITE " ",Y
SET WSD=Y
+16 KILL DIR
+17 SET DIR("A")=" End Date"
SET DIR(0)="D"
DO ^DIR
+18 if Y=""!(Y[U)
GOTO EX
+19 IF Y<SD!(Y>DT)
WRITE *7,?40,"Invalid date sequence!!",!
GOTO T
+20 SET $PIECE(^ONCO(160.1,OSP,0),U,6)=Y
+21 SET (ED,X)=Y
DO DD^%DT
WRITE " ",Y,!
+22 SET WED=Y
+23 SET DIR("A")=" Dates OK"
SET DIR("B")="Y"
SET DIR(0)="Y"
DO ^DIR
+24 if 'Y
GOTO T
if Y[U!(Y="")
GOTO EX
+25 WRITE !!?15,"We will find suspicious malignancies"
+26 WRITE !?15,"From: ",WSD_" To: "_WED,!
+27 WRITE !
SET ONCO("SD")=SD
SET ONCO("ED")=ED
SET ONCO("MG")=MG
+28 ;
TSK ;Create task
+1 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+2 IF '$DATA(IO("Q"))
DO SER^ONCOCFR
GOTO EX
+3 SET ZTRTN="SER^ONCOCFR"
SET ZTSAVE("ONCO*")=""
SET ZTDESC="ONCOLOGY RADIOLOGY SEARCH"
DO ^%ZTLOAD
GOTO EX
+4 ;
SER ;Search RAD/NUC MED PATIENT (70) file/Set multidivisional variables
+1 SET AFFDIV=$GET(DUZ(2))
SET ONCDIVSP=$ORDER(^ONCO(160.1,"C",AFFDIV,""))
+2 IF ONCDIVSP=""
WRITE !!,"User does not have an associated DIVISION!",!!
GOTO EX
+3 FOR Z=0:0
SET Z=$ORDER(^ONCO(160.1,ONCDIVSP,6,Z))
if Z'>0
QUIT
SET AFFDIV=AFFDIV_U_$GET(^ONCO(160.1,ONCDIVSP,6,Z,0))
+4 KILL ^TMP("ONCO",$JOB)
SET (XSD,XDT)=ONCO("SD")-.1111111
SET XED=ONCO("ED")+.9999999
SET MG=ONCO("MG")
FOR J=0,1,2
SET ^TMP("ONCO",$JOB,J)=0
+5 FOR
SET XDT=$ORDER(^RADPT("AR",XDT))
if XDT=""!(XDT>XED)
QUIT
SET D0=0
FOR
SET D0=$ORDER(^RADPT("AR",XDT,D0))
if D0'>0
QUIT
SET D1=$ORDER(^RADPT("AR",XDT,D0,0))
Begin DoDot:1
+6 SET D2=0
FOR
SET D2=$ORDER(^RADPT(D0,"DT",D1,"P",D2))
if D2'>0
QUIT
Begin DoDot:2
+7 SET RA0=$GET(^(D2,0))
IF RA0=""
QUIT
+8 SET PC13=$PIECE(RA0,U,13)
IF PC13=""
QUIT
+9 ;S EXP=$$GET1^DIQ(78.3,PC13,6),EXP=$TR(EXP,"malig","MALIG"),EXP=$TR(EXP,"Suspicious","SUSPICIOUS")
+10 ;S MG=$P($G(^RA(78.3,PC13,0)),U,1),MG=$TR(MG,"malig","MALIG"),MG=$TR(MG,"cancer","CANCER")
+11 SET EXP=$$GET1^DIQ(78.3,PC13,6)
SET EXP=$TRANSLATE(EXP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+12 SET MG=$PIECE($GET(^RA(78.3,PC13,0)),U,1)
SET MG=$TRANSLATE(MG,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+13 IF (MG["MALIG")!(MG["CANCER")!(EXP["MALIG")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+14 IF (MG["BLASTOMA")!(MG["CARCINOMA")!(MG["GLIOMA")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+15 IF (MG["ACOUSTIC NEUROMA")!(MG["ASTROCYTOMA")!(MG["CARCINOID")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+16 IF (MG["DCIS")!(MG["HCC")!(MG["HODGKIN")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+17 IF (MG["IPNM")!(MG["LYMPHOMA")!(MG["MENINGIOMA")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+18 IF (MG["MESOTHELIOMA")!(MG["METASTA")!(MG["PITUITARY ADENOMA")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+19 IF (MG["SARCOMA")!(MG["SCHWANNOMA")!(MG["TUMOR")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+20 SET D3=0
FOR
SET D3=$ORDER(^RADPT(D0,"DT",D1,"P",D2,"DX",D3))
if D3'>0
QUIT
Begin DoDot:3
+21 SET RASDC0=$GET(^(D3,0))
IF RASDC0=""
QUIT
+22 SET PC1=$PIECE(RASDC0,U,1)
IF PC1=""
QUIT
+23 ;S EXP=$$GET1^DIQ(78.3,PC1,6),EXP=$TR(EXP,"malig","MALIG"),EXP=$TR(EXP,"Suspicious","SUSPICIOUS")
+24 ;S MG=$P($G(^RA(78.3,PC1,0)),U,1),MG=$TR(MG,"malig","MALIG"),MG=$TR(MG,"cancer","CANCER")
+25 SET EXP=$$GET1^DIQ(78.3,PC1,6)
SET EXP=$TRANSLATE(EXP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+26 SET MG=$PIECE($GET(^RA(78.3,PC1,0)),U,1)
SET MG=$TRANSLATE(MG,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+27 IF (MG["MALIG")!(MG["CANCER")!(EXP["MALIG")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+28 IF (MG["BLASTOMA")!(MG["CARCINOMA")!(MG["GLIOMA")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+29 IF (MG["ACOUSTIC NEUROMA")!(MG["ASTROCYTOMA")!(MG["CARCINOID")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+30 IF (MG["DCIS")!(MG["HCC")!(MG["HODGKIN")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+31 IF (MG["IPMN")!(MG["LYMPHOMA")!(MG["MENINGIOMA")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+32 IF (MG["MESOTHELIOMA")!(MG["METASTA")!(MG["PITUITARY ADENOMA")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
+33 IF (MG["SARCOMA")!(MG["SCHWANNOMA")!(MG["TUMOR")
SET RA($PIECE(^RADPT(D0,0),U))=$PIECE(XDT,".")_U_$PIECE(RA0,U,2)_U_D1
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
CK ;Check ONCOLOGY PATIENT (160) file
GT SET XX=0
FOR
SET XX=$ORDER(RA(XX))
if XX=""
QUIT
Begin DoDot:1
+1 DO DIV
if DVMTCH=0
QUIT
+2 SET ^TMP("ONCO",$JOB,0)=^TMP("ONCO",$JOB,0)+1
+3 SET HT=0
SET X=XX_";DPT("
+4 SET XDT=$PIECE(RA(XX),U)
SET XD0=$ORDER(^ONCO(160,"B",X,0))
SET ONCIEN=XD0
+5 IF XD0=""
DO MR
QUIT
+6 IF XD0'=""
SET ONCDIVS=""
SET ONCS=""
FOR
SET ONCS=$ORDER(^ONCO(160,XD0,"SUS","C",ONCS))
if ONCS'>0
QUIT
SET ONCDIVS=ONCDIVS_U_ONCS
+7 IF ONCDIVS'[DUZ(2)
Begin DoDot:2
+8 SET (D0,DA)=XD0
IF '$DATA(^ONCO(165.5,"C",XD0))
DO N2
QUIT
+9 IF $DATA(^ONCO(165.5,"C",XD0))
DO CKP
IF 'HT
DO N2
QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 ;
RPT ; Generate report
+1 IF $GET(^TMP("ONCO",$JOB,2))=0
SET DIC="^ONCO(160.1,"
SET BY="[ONCO NEG-REPORT]"
+2 IF '$TEST
Begin DoDot:1
+3 SET DIC="^ONCO(160,"
+4 SET BY="@75,INTERNAL(#3),75,.01"
+5 SET FR=DUZ(2)_","_ONCO("SD")
SET TO=DUZ(2)_","_ONCO("ED")
+6 SET FLDS="[ONCO RAD-CASEFINDING RPT]"
+7 QUIT
End DoDot:1
+8 ;
PRT ; Call print routine
+1 SET L=0
SET IOP=ION
SET DIOEND="D WP^ONCOCFR"
+2 DO EN1^DIP
GOTO EX
+3 ;
WP ; Wrap-up report
+1 WRITE !!!?30,"RADIOLOGY CASEFINDING RESULTS"
+2 WRITE !!?30,^TMP("ONCO",$JOB,0)_" Cases found",!?30,^TMP("ONCO",$JOB,1)_" New Patients added",!?30,^TMP("ONCO",$JOB,2)_" New cases added",!!
+3 QUIT
+4 ;
CKP ;CHECK Primary File
+1 SET XD1=0
FOR
SET XD1=$ORDER(^ONCO(165.5,"C",XD0,XD1))
if XD1'>0
QUIT
IF $$DIV^ONCFUNC(XD1)=DUZ(2)
Begin DoDot:1
+2 SET XDX=$PIECE($GET(^ONCO(165.5,XD1,0)),U,16)
IF XDX=XDT
SET HT=1
QUIT
+3 SET XDX=$PIECE($GET(^ONCO(165.5,XD1,1)),U,10)
IF XDX=XDT
SET HT=1
QUIT
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
MR ;Create new ONCOLOGY PATIENT (160) record
+1 SET DIC="^ONCO(160,"
SET DIC(0)="Z"
DO FILE^DICN
SET (ONCIEN,D0,DA)=+Y
SET ^TMP("ONCO",$JOB,1)=^TMP("ONCO",$JOB,1)+1
N2 ;Create new SUSPENSE (160,75) record
+1 KILL DD,DO
+2 SET DA(1)=ONCIEN
SET DIC="^ONCO(160,"_DA(1)_",""SUS"","
+3 SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(160,75,0),U,2)
SET X=XDT
+4 DO FILE^DICN
+5 KILL DIE
SET DA(1)=ONCIEN
SET DIE="^ONCO(160,"_DA(1)_",""SUS"","
+6 SET (ONCSUB,DA)=+Y
SET RDP=$PIECE(RA(XX),U,2)
+7 SET DR="1///^S X=DT;2///^S X=""RA"";3////^S X=DUZ(2);6////^S X=RDP"
DO ^DIE
+8 SET ^TMP("ONCO",$JOB,2)=^TMP("ONCO",$JOB,2)+1
+9 QUIT
+10 ;
DIV ;Division match
+1 SET DVMTCH=1
SET INST=""
SET RE1=$PIECE(RA(XX),U,3)
IF RE1=""
QUIT
+2 SET INST=$PIECE($GET(^RADPT(XX,"DT",RE1,0)),U,3)
IF INST=""
QUIT
+3 IF AFFDIV'[INST
SET DVMTCH=0
QUIT
+4 QUIT
+5 ;
EX ;EXIT
+1 KILL %ZIS,AFFDIV,BY,D0,D1,D2,D3,DA,DIC,DIOEND,DR,DVMTCH,ED,EXP,FLDS,FR,HT
+2 KILL INST,IOP,J,L,MG,ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCOUT,ONCS,ONCSUB,OSP
+3 KILL PC1,PC13,POP,RA,RA0,RASDC0,RDP,RE1,SD,TO,WED,WSD,X,XD0,XD1,XDT,XDX
+4 KILL XED,XSD,XX,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ONCDIVSP
+5 KILL ^TMP("ONCO",$JOB)
+6 DO ^%ZISC
+7 QUIT
