close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOSCT2.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOSCT2.m@ 846

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
1ONCOSCT2 ;WASH ISC/SRR,MLH-CROSS TABS 2 ;8/21/93 11:09
2 ;;2.11;ONCOLOGY;**5,23**;Mar 07, 1995
3 ;mda/ssb (originator);nci/ytm (first editor/rewriter)
4OUTPUT ;sum & write table
5 ;in: ^TMP($J,"CELL"),COLCUTS,COLDD,NPG,ROWCUTS,ROWDD,TOT,XCRT
6 ;out: COLS,NPG,ROWS
7 ;use: ^TMP
8 ;CWID=Column width,RLWID=Row Width,ROWHEAD=length Row variable
9 U IO
10 N C,CWID,COL,LC,LNCOLS,R,RLWID,ROW,ROWHEAD,VAL
11 S FNAM=$P(@(GBL_"0)"),U),FNAM=$S($P(FNAM," ")="ONCOLOGY":$P(FNAM," ",2))
12 S HLAB=FNAM_$S(TEMPL:" Template ",1:"")_$P(HEADER,U)
13 S W=$G(ONCOS("CW")),CWID=$S(W="":9,1:W),W=$G(ONCOS("RW")),RLWID=$S(W="":20,1:W),R="",ROWHEAD=$L($P(ROWDD,U,1))
14 F ROWS=0:1 S R=$O(^TMP($J,"CELL",R)) Q:R="" D SUMLAB
15 S:COLDD="" ^TMP($J,"CSUM",1)="" S C=""
16 F COLS=1:1 S C=$O(^TMP($J,"CSUM",C)) Q:C="" S ^TMP($J,"COL",COLS)=C
17 S OT=$G(ONCOS("AF"))
18 S COLS=COLS-1,ROWHEAD=$S(ROWHEAD<8:8,ROWHEAD>RLWID:RLWID,1:ROWHEAD)
19 S LNCOLS=IOM-ROWHEAD-(2*CWID)\CWID
20 F COL=1:LNCOLS:COLS Q:ONCOEX S LC=COL+LNCOLS-1 S:LC>COLS LC=COLS D WCHEAD,WROWS
21 Q:ONCOEX I XCRT,'$D(ONCOS("D")) W *7,!! R "Press Return for next table or '^' to Exit: ",X:DTIME W ! S ONCOEX=$S('$T:1,X="^":1,1:0) Q:ONCOEX
22 W ! Q:OT'=3
23 ;
24GETLAB ;get label
25 ;in: CUTS,UNK,YDD,Y
26 ;out: Y
27 I Y=UNK S Y="?" Q
28 I $P(YDD,U,2)["P" S:$D(@("^"_$P(YDD,U,3)_Y_",0)"))#2 Y=$P(^(0),U,1) ; note that the indirect reference sets the naked indicator
29 S:CUTS]""&(Y=+Y) X="GT "_$P(CUTS,":",Y-1)_" - LE "_$P(CUTS,":",Y),Y=$S(Y=1:$P(X,"- ",2),Y=$L(CUTS,":"):$P(X,"- ",1),1:X)
30 Q:$P(YDD,U,2)'["S"
31 S Z=$P(YDD,U,3)
32 F %=1:1 S X=$P(Z,";",%) Q:X="" I Y=$P(X,":",1) S Y=$P(X,":",2) Q
33 Q
34 ;
35SETCOL ;setup col sum & get label
36 ;in: C,RSUM,VAL,^TMP
37 ;out: RSUM,^TMP
38 I $D(^TMP($J,"CSUM",C))=0 S ^TMP($J,"CSUM",C)=0,Y=C D GETLAB S ^TMP($J,"CLAB",C)=Y
39 S ^TMP($J,"CSUM",C)=^TMP($J,"CSUM",C)+VAL,RSUM=RSUM+VAL
40 Q
41 ;
42SUMLAB ;sum marginals & get labels
43 ;in: ^TMP($J,"CELL"),COLCUTS,COLDD,R,ROWCUTS,ROWDD,ROWHEAD,UNK
44 ;out: ROWHEAD,^TMP
45 ;use: C,COL,VAL
46 N CUTS,RSUM,YDD S YDD=ROWDD,Y=R,CUTS=ROWCUTS D GETLAB
47 S ^TMP($J,"RLAB",R)=Y Q:COLDD=""
48 S:$L(Y)>ROWHEAD ROWHEAD=$L(Y) S C="",RSUM=0,CUTS=COLCUTS,YDD=COLDD
49 F COL=0:1 S C=$O(^TMP($J,"CELL",R,C)) Q:C="" S VAL=^(C) D SETCOL
50 S ^TMP($J,"RSUM",R)=RSUM
51 Q
52 ;
53TOF ;top of form
54 ;in: NPG,XCRT
55 ;out: NPG
56 Q
57 ;
58WCHEAD ;write column header
59 ;in: COL,LC,LNCOLS,COLDD,ROWDD,ROWHEAD,^TMP
60 ;use: C
61 Q:ONCOEX
62 N POS,ROW2 S ROW2=""
63 D:(COL=1&(NPG=0))!($Y+$S(COLDD="":4,1:4)>IOSL) WPHEAD Q:ONCOEX G WCH1:COLDD=""
64 S X=$P(COLDD,U,1),POS=ROWHEAD+CWID+$S(COL>COLS:0,1:(LC-COL+1)*CWID\2)-($L(X)\2)
65 W !!,?POS,X,! S POS=CWID\2+ROWHEAD
66 I COL'>COLS F C=COL:1:LC D WCLAB S POS=POS+CWID
67 S X="Total" D WCLAB1
68WCH1 W !,$E($P(ROWDD,U,1),1,ROWHEAD),":",! Q:COLDD=""
69 I ROW2]"" F C=1:1 S X=$P(ROW2,U,C) Q:X="" W ?+X,$P(X,";",2)
70 Q
71 ;
72WCLAB ;write col label
73 ;in: C,POS,^TMP
74 ;out: ROW2
75 S X=$E(^TMP($J,"CLAB",^TMP($J,"COL",C)),1,CWID-1)
76WCLAB1 S Y=$L(X),Z=POS+$S(Y=0:0,Y=1:CWID-2,Y'>CWID:CWID-Y,1:(CWID+1-Y)\2-1)
77 I Z>$X W ?Z,X
78 E S ROW2=ROW2_Z_";"_X_U
79 Q
80 ;
81WPHEAD ;write page header
82 Q:ONCOEX
83XX I XCRT&NPG W *7,! R "Press 'Return/Enter' to continue, '^' to Exit: ",X:DTIME W ! S ONCOEX=$S('$T:1,X="^":1,1:0) Q:ONCOEX
84YY W:$Y @IOF S NPG=NPG+1
85 W HLAB
86 W " Cross Tabs",?IOM-30,$P(HEADER,U,2)," Page ",NPG,!
87 F X=1:1:IOM-1 W "-"
88 Q
89 ;
90WROWS ;write rows
91 ;in: COL,COLDD,CUTS,LC,LNCOLS,ROWDD,ROWS,TOT,^TMP($J)
92 ;use: C,R,ROW
93 S R="" F ROW=1:1:ROWS S R=$O(^TMP($J,"CELL",R)) Q:R=""!ONCOEX D WR1
94 Q:ONCOEX D:$Y+PCT+3>IOSL WPHEAD,WCHEAD Q:ONCOEX W !," Total",?CWID\2+ROWHEAD
95 I COLDD]"" F C=COL:1:LC W $J(^TMP($J,"CSUM",^TMP($J,"COL",C)),CWID)
96 W $J(TOT,CWID) Q:'PCT W !," %",?CWID\2+ROWHEAD
97 I COLDD]"" F C=COL:1:LC W $J(^TMP($J,"CSUM",^TMP($J,"COL",C))*100/TOT,CWID,1)
98 W $J("100.0",CWID),! F X=1:1:IOM-1 W "-"
99 Q
100WR1 ;write row data lines
101 D:$Y+PCT+3>IOSL WPHEAD,WCHEAD Q:ONCOEX
102 S X=$E(^TMP($J,"RLAB",R),1,ROWHEAD)
103 S:X=+X&($L(X)<5) X=$J(X,5) W !,X,?CWID\2+ROWHEAD
104 F C=COL:1:LC S Y=^TMP($J,"COL",C),X=+$G(^TMP($J,"CELL",R,Y)) W $J(X,CWID)
105 I COLDD]""&(COL+LNCOLS>COLS+1) W $J(^TMP($J,"RSUM",R),CWID)
106 Q:'PCT W !,?CWID\2+ROWHEAD
107 F C=COL:1:LC S Y=^TMP($J,"COL",C),X=+$G(^TMP($J,"CELL",R,Y))*100/TOT W $J(X,CWID,1)
108 I COLDD]""&(COL+LNCOLS>COLS+1) W $J(^TMP($J,"RSUM",R)*100/TOT,CWID,1)
109 W ! F X=1:1:IOM-1 W "-"
110 Q
Note: See TracBrowser for help on using the repository browser.