source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOCFR.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1ONCOCFR ;Hines OIFO/GWB - RADIOLOGY CASEFINDING; 7/21/93
2 ;;2.11;ONCOLOGY;**13,24,25,26,27,34,37,39,46**;Mar 07, 1995;Build 39
3 ;
4ST ;Start RAD/NUC MED PATIENT (70) file search
5 W @IOF
6 W !!!?10,"******** RADIOLOGY: SUSPICIOUS MALIGNANCY SEARCH ********",!!
7 W ?10,"This option searches the RAD/NUC MED PATIENT file and will",!
8 W ?10,"add to your 'suspense list' in the ONCOLOGY PATIENT file.",!
9MG 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
10 G T:MG W !!?15,"MALIGNACY diagnostic code is not defined in the"
11 W !?15,"Radiology Diagnostic Codes File (#78.3). Please"
12 W !?15,"REQUEST Radiology to code suspicious MALIGNANCIES"
13 W !!!?10,"MUST terminate Radiology Search - no meaningful search code" G EX
14 ;
15T ;Start Date/End Date
16 S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
17 K DIR
18 S Y=$P(^ONCO(160.1,OSP,0),U,6)
19 I Y="" S Y=DT
20 S Y=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
21 S DIR("B")=Y
22 W !
23 S DIR("A")=" Start Date",DIR(0)="D" D ^DIR
24 G EX:Y<1!(Y[U)
25 S (SD,X)=Y D DD^%DT W " ",Y S WSD=Y
26 K DIR
27 S DIR("A")=" End Date",DIR(0)="D" D ^DIR
28 G EX:Y=""!(Y[U)
29 I Y<SD!(Y>DT) W *7,?40,"Invalid date sequence!!",! G T
30 S $P(^ONCO(160.1,OSP,0),U,6)=Y
31 S (ED,X)=Y D DD^%DT W " ",Y,!
32 S WED=Y
33 S DIR("A")=" Dates OK",DIR("B")="Y",DIR(0)="Y" D ^DIR
34 G T:'Y,EX:Y[U!(Y="")
35 W !!?15,"We will find suspicious malignancies"
36 W !?15,"From: ",WSD_" To: "_WED,!
37 W ! S ONCO("SD")=SD,ONCO("ED")=ED,ONCO("MG")=MG
38 ;
39TSK ;Create task
40 K IO("Q") S %ZIS="Q" D ^%ZIS I POP S ONCOUT="" G EX
41 I '$D(IO("Q")) D SER^ONCOCFR G EX
42 S ZTRTN="SER^ONCOCFR",ZTSAVE("ONCO*")="",ZTDESC="ONCOLOGY RADIOLOGY SEARCH" D ^%ZTLOAD G EX
43 ;
44SER ;Search RAD/NUC MED PATIENT (70) file/Set multidivisional variables
45 S AFFDIV=$G(DUZ(2)),ONCDIVSP=$O(^ONCO(160.1,"C",AFFDIV,""))
46 I ONCDIVSP="" W !!,"User does not have an associated DIVISION!",!! G EX
47 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))
48 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
49 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
50 .S D2=0 F S D2=$O(^RADPT(D0,"DT",D1,"P",D2)) Q:D2'>0 D
51 ..S RA0=$G(^(D2,0)) I RA0="" Q
52 ..S PC13=$P(RA0,U,13) I PC13="" Q
53 ..S MG=$P($G(^RA(78.3,PC13,0)),U,1),MG=$TR(MG,"malig","MALIG")
54 ..I MG["MALIG" S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
55 ..S D3=0 F S D3=$O(^RADPT(D0,"DT",D1,"P",D2,"DX",D3)) Q:D3'>0 D
56 ...S RASDC0=$G(^(D3,0)) I RASDC0="" Q
57 ...S PC1=$P(RASDC0,U,1) I PC1="" Q
58 ...S MG=$P($G(^RA(78.3,PC1,0)),U,1),MG=$TR(MG,"malig","MALIG")
59 ...I MG["MALIG" S RA($P(^RADPT(D0,0),U))=$P(XDT,".")_U_$P(RA0,U,2)_U_D1
60 ;
61CK ;Check ONCOLOGY PATIENT (160) file
62GT S XX=0 F S XX=$O(RA(XX)) Q:XX="" D
63 .D DIV Q:DVMTCH=0
64 .S ^TMP("ONCO",$J,0)=^TMP("ONCO",$J,0)+1
65 .S HT=0,X=XX_";DPT("
66 .S XDT=$P(RA(XX),U),XD0=$O(^ONCO(160,"B",X,0)),ONCIEN=XD0
67 .I XD0="" D MR Q
68 .I XD0'="" S ONCDIVS="",ONCS="" F S ONCS=$O(^ONCO(160,XD0,"SUS","C",ONCS)) Q:ONCS'>0 S ONCDIVS=ONCDIVS_U_ONCS
69 .I ONCDIVS'[DUZ(2) D
70 ..S (D0,DA)=XD0 I '$D(^ONCO(165.5,"C",XD0)) D N2 Q
71 ..I $D(^ONCO(165.5,"C",XD0)) D CKP I 'HT D N2 Q
72 .Q
73 ;
74RPT ; Generate report
75 I $G(^TMP("ONCO",$J,2))=0 S DIC="^ONCO(160.1,",BY="[ONCO NEG-REPORT]"
76 E D
77 .S DIC="^ONCO(160,"
78 .S BY="@75,INTERNAL(#3),75,.01"
79 .S FR=DUZ(2)_","_ONCO("SD"),TO=DUZ(2)_","_ONCO("ED")
80 .S FLDS="[ONCO RAD-CASEFINDING RPT]"
81 .Q
82 ;
83PRT ; Call print routine
84 S L=0,IOP=ION,DIOEND="D WP^ONCOCFR"
85 D EN1^DIP G EX
86 ;
87WP ; Wrap-up report
88 W !!!?30,"RADIOLOGY CASEFINDING RESULTS"
89 W !!?30,^TMP("ONCO",$J,0)_" Cases found",!?30,^TMP("ONCO",$J,1)_" New Patients added",!?30,^TMP("ONCO",$J,2)_" New cases added",!!
90 Q
91 ;
92CKP ;CHECK Primary File
93 S XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
94 .S XDX=$P($G(^ONCO(165.5,XD1,0)),U,16) I XDX=XDT S HT=1 Q
95 .S XDX=$P($G(^ONCO(165.5,XD1,1)),U,10) I XDX=XDT S HT=1 Q
96 .Q
97 Q
98 ;
99MR ;Create new ONCOLOGY PATIENT (160) record
100 S DIC="^ONCO(160,",DIC(0)="Z" D FILE^DICN S (ONCIEN,D0,DA)=+Y,^TMP("ONCO",$J,1)=^TMP("ONCO",$J,1)+1
101N2 ;Create new SUSPENSE (160,75) record
102 K DD,DO
103 S DA(1)=ONCIEN,DIC="^ONCO(160,"_DA(1)_",""SUS"","
104 S DIC(0)="L",DIC("P")=$P(^DD(160,75,0),U,2),X=XDT
105 D FILE^DICN
106 K DIE S DA(1)=ONCIEN,DIE="^ONCO(160,"_DA(1)_",""SUS"","
107 S (ONCSUB,DA)=+Y,RDP=$P(RA(XX),U,2)
108 S DR="1///^S X=DT;2///^S X=""RA"";3////^S X=DUZ(2);6////^S X=RDP" D ^DIE
109 S ^TMP("ONCO",$J,2)=^TMP("ONCO",$J,2)+1
110 Q
111 ;
112EX ;EXIT
113 K ONCO,ED,HT,MG,OSP,RA,RA0,RASDC0,RAO,SD,WED,WSD,XX,DIJ,DP,D,D0
114 K %T,%ZISOS
115 K AFFDIV,DVMTCH,INST,ONCDIVSP,RE1,Z,^TMP("ONCO",$J) D ^%ZISC
116 Q
117 ;
118DIV ;Division match
119 S DVMTCH=1,INST="",RE1=$P(RA(XX),U,3) I RE1="" Q
120 S INST=$P($G(^RADPT(XX,"DT",RE1,0)),U,3) I INST="" Q
121 I AFFDIV'[INST S DVMTCH=0 Q
122 Q
Note: See TracBrowser for help on using the repository browser.