source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOSC1.m@ 1036

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1ONCOSC1 ;WASH ISC/SRR-CROSS TAB REPORT TASKS ;12/14/99
2 ;;2.11;ONCOLOGY;**25**;Mar 07, 1995
3 ;
4TOT ;Task for Total Registry Cross Tabs
5 ;in: ONCOS*
6 K ER S ONCOEX=0 D SETV,TEM G EX:$D(ER) S ONCOS("T")=$S(TEM="ALL":TEM,1:XDG_U_TEM) I ONCOS("C")'="ALL" D PRINT^ONCOSCT G EX
7 S ONCOS("TK")="" F CT=1:1:$S(ONCOS("GP")=1:15,1:12) Q:ONCOEX S ONCOS("C")=$P($P(ONCOS("CT"),";",CT),":",2) D PRINT^ONCOSCT
8 G EX
9 ;
10SETV ;RESET VARIABLES
11 S (ONCOS("N"),ONCOS("Y"))="",ONCOS("FI")="165.5^ONCOLOGY PRIMARY^ONCO(165.5,"
12 Q
13 ;
14TEM ;Setup templates
15 S YR=ONCOS("YR"),GP=ONCOS("GP"),BYR=+ONCOS("YR"),EYR=$P(ONCOS("YR"),U,2) G ALL:YR="ALL",ANN:BYR=EYR,RGE
16 Q
17 ;
18ALL S TEM="ONCOS TOTAL-",TEM=$S(GP=0:TEM_"NON",GP=1:TEM_"ANAL",1:"ALL")
19 Q:TEM="ALL" S XDG=$O(^DIBT("F165.5",TEM,0)) Q:XDG="" K ^DIBT(XDG,1)
20 I GP<2 S XD0=0 F S XD0=$O(^ONCO(165.5,"AG",GP,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) S ^DIBT(XDG,1,XD0)=""
21 I GP=2 F GP=0,2 S XD0=0 D
22 .F S XD0=$O(^ONCO(165.5,"AG",GP,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) S ^DIBT(XDG,1,XD0)=""
23 Q
24 ;
25ANN S TEM="ONCOS ANNUAL-",TEM=TEM_$S(GP=1:"ANALYTIC",GP=0:"NON ANAL",1:"ALLCASES")
26 S XDG=$O(^DIBT("F165.5",TEM,0)) Q:XDG="" K ^DIBT(XDG,1)
27 S XD0=0 F S XD0=$O(^ONCO(165.5,"AY",+YR,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) D
28 .I GP=2 S ^DIBT(XDG,1,XD0)="" Q
29 .I $P(^ONCO(165.5,XD0,0),U,20)=GP S ^DIBT(XDG,1,XD0)=""
30 Q
31 ;
32RGE S TEM="ONCOS RANGE-",TEM=$S(GP=1:TEM_"ANALYTIC",GP=0:TEM_"NON ANAL",1:TEM_"ALLCASES")
33 S XDG=$O(^DIBT("F165.5",TEM,0)) Q:XDG="" K ^DIBT(XDG,1)
34 S XD0=0 F YY=BYR:1:EYR D
35 .F S XD0=$O(^ONCO(165.5,"AY",YY,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) D
36 ..I GP=2 S ^DIBT(XDG,1,XD0)="" Q
37 ..I $P(^ONCO(165.5,XD0,0),U,20)=GP S ^DIBT(XDG,1,XD0)=""
38 Q
39ERR ;NO TEMPLATE
40 S XD0=0 F S XD0=$O(^ONCO(165.5,"AG",0,XD0)) Q:XD0=""
41EX ;EXIT
42 D KIL^ONCOSCT K CT,J,K,%DT,%ZISOS,BYR,EYR,GLO,OT,ROWDEF,TF,W,YR,B,C,CO,DIC,ER,F,GP,ONCOEX
43 K I,HEAD,%T,%I,XCOL
44 Q
Note: See TracBrowser for help on using the repository browser.