source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOSCT.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1ONCOSCT ;Hines OIFO/GWB,RTK - CROSS TABULATE ;9/3/93
2 ;;2.11;ONCOLOGY;**23,30,43**;Mar 07, 1995
3IN ;DIRECT CALL set ONCOS("D")=1
4 ;in: ^DIBT,^DIPT
5 ;ONCOS - used to force responses to setup prompts
6 ;("F") = file number
7 ;("T") = search template
8 ;("R") = row field name^cutpoints, e.g., "AGE^10:20:30:40"
9 ;("C") = column field name^cutpoints
10 ;("P") = 1 to print total per cents, 0 to skip prompt
11 ;("Y") = yes prompts
12 ;("I") = IOP variable for %ZIS
13 ;("H") = HEADER (if defined, not asked for in ONCOSCINP)
14 ;("D") = Direct Program call, not entered at Print
15 ;do: ^ONCOSINP,^ONCOSCT*,WAIT^DICD,^%DT,^%ZIS
16 S ONCOS("D")=1 W !,"ONCOLOGY Version 2 - Cross-tabs",! ;S:'$D(DTIME) DTIME=1000
17PRINT ;entry point for queued report (%ZTLOAD)
18 S:$D(ONCOION) ION=ONCOION S:$D(ONCOIOM) IOM=ONCOIOM
19 W !! S (ROWDEF,TEMPL)=-1,UNK="~",XCRT=$S($G(IOST)?1"C".E:1,1:0),%=0 D GETFILE^ONCOSINP:'$D(ONCOS("FI"))
20 S FNUM=+ONCOS("FI") I '$D(ONCOS("T")) D GETTEMPL^ONCOSINP G EX:'Y S ONCOS("T")=Y G EN
21 I ONCOS("T")'["^" D GETTEMPL^ONCOSINP G EX:Y<0 S ONCOS("T")=Y
22EN S ONCOEX=0,TEMPL=ONCOS("T"),TEMPL=$S(TEMPL="ALL":TEMPL,1:+TEMPL),HEAD=$G(ONCOS("H")),HEADER=$S(HEAD="":$P(ONCOS("T"),U,2),1:HEAD)
23 S FNUM=+ONCOS("FI"),GLO="^"_$P(ONCOS("FI"),U,3) D SETUP^ONCOSCT1 G EX:ROWDD=""!(ONCOEX)
24 G CON:$D(ONCOS("TK")) I '$D(ONCOS("AF")) S ONCOS("AF")=1
25 K IO("Q") S %ZIS="Q",%ZIS("A")=" Select device to Print Cross Tabs: " D ^%ZIS I POP S ONCOUT="" G EX
26 I '$D(IO("Q")) D TSK^ONCOSCT G EX
27 S ZTRTN="TSK^ONCOSCT",ZTDESC=HEADER
28 S ZTSAVE("ONCOS*")=""
29 S ZTSAVE("TEMPL")="",ZTSAVE("XCRT")="",ZTSAVE("UNK")=""
30 S ZTSAVE("COLCUTS")="",ZTSAVE("ROWCUTS")=""
31 S ZTSAVE("COLDD")="",ZTSAVE("ROWDD")=""
32 S ZTSAVE("PCT")="",ZTSAVE("HEADER")=""
33 D ^%ZTLOAD G EX
34 ;
35TSK ;Task for internal direct calling of ONCOSCT, not from another task.
36 K ^TMP($J) S ONCOEX=0 S:'$D(ONCOS("AF")) ONCOS("AF")=1
37 S XCRT=$S($G(IOST)?1"C".E:1,1:0)
38 D WAIT^DICD:XCRT
39CON W ! S %DT="T",X="NOW" D ^%DT X ^DD("DD") S GBL="^"_$P(ONCOS("FI"),U,3)
40 S HEADER=HEADER_U_$P(Y,"@",1)_" "_$P(Y,"@",2),(D0,NPG,TOT)=0
41TEM I TEMPL'="ALL" S D0=0 F N=1:1 S D0=$O(^DIBT(TEMPL,1,D0)) G OUT:D0'>0 D CTCASE
42 F N=1:1 S D0=$O(@(GBL_"D0)")) Q:D0'>0 D CTCASE
43OUT ;OUTPUT
44 S ONCOEX=0 D OUTPUT^ONCOSCT2 G EX:ONCOEX G EX:'$D(ONCOS("TK"))
45KIL ;Entry point to kill all variables at EXCEPT 'ONCOS' ARRAY
46 K ^TMP($J)
47 K COLCUTS,COLDD,COLPIECE,COLS,COLSUB,D0,FNUM
48 K GLB,GLO,HEAD,HEADER,N,NPG,PCT,POP,B,C,F,XX,Y,Z
49 K ROWCUTS,ROWS,ROWDD,ROWPIECE,ROWSUB,TEMPL,TOT,UNK,X,XCRT
50 K %,%DT,%K,%T,%ZISOS,HEAD,OF
51 Q
52 ;
53EX ;Complete Exit
54 D KIL K ONCOS K:$D(ONCOS("D")) ONCOEX D ^%ZISC Q
55CTCASE ;count case
56 ;in: COLCUTS,COLDD,COLPIECE,COLSUB,D0,GBL,N,ONCOS,TOT
57 ; ROWCUTS,ROWDD,ROWPIECE,ROWSUB,UNK,XCRT
58 ;out: ^TMP($J,"CELL"),TOT
59 N R,C
60 S:COLDD]"" X=$P(COLDD,U,4),COLPIECE=$P(X,";",2),COLSUB=+X
61 S X=$P(ROWDD,U,4),ROWPIECE=$P(X,";",2),ROWSUB=+X
62 W:XCRT&(N#100=1) "." Q:'$D(@(GBL_"D0)")) S TOT=TOT+1,(R,C)=UNK
63 I $P(ROWDD,U,2)'["C" S:$D(@(GBL_"D0,ROWSUB)"))#10=1 R=$P(@(GBL_"D0,ROWSUB)"),U,ROWPIECE)
64 E X $P(ROWDD,U,5,99) S Y=X D:$P(ROWDD,U,2)["D" DD^%DT S X=Y S R=X
65 I COLDD="" S C=1 G CT1
66 I $P(COLDD,U,2)'["C" S:$D(@(GBL_"D0,COLSUB)"))#10=1 C=$P(@(GBL_"D0,COLSUB)"),U,COLPIECE)
67 E X $P(COLDD,U,5,99) S Y=X D:$P(COLDD,U,2)["D" DD^%DT S X=Y S C=X
68CT1 I C="" S C=UNK
69 E I COLCUTS]"" S X=C F C=1:1:$L(COLCUTS,":") I X'>$P(COLCUTS,":",C) Q
70 I R="" S R=UNK
71 E I ROWCUTS]"" S X=R F R=1:1:$L(ROWCUTS,":") I X'>$P(ROWCUTS,":",R) Q
72TT I '$D(^TMP($J,"CELL",R,C)) S ^TMP($J,"CELL",R,C)=1 Q
73 S ^(C)=^TMP($J,"CELL",R,C)+1
74 Q
Note: See TracBrowser for help on using the repository browser.