ONCOSCT1 ;Hines OIFO/GWB - CROSS TAB SETUP ;7/27/92
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
GC ;GET CUTS
;
ABORT S ROWDD=""
Q
;
SETUP ;get options
;in: ^DD,^DIPT,FNUM,ONCOS,TEMPL
;out: COLCUTS,COLDD,HEADER,PCT,ROWCUTS,ROWDD
;do: ^ONCOSINP,^DIC
N CUTS,DIC,FDD,FLD
S1 S ROWDD="",DIC="^DD("_FNUM_",",DIC("S")="I +$P(^(0),U,2)=0 "
F FLD="COLUMN","ROW" D GETFLD Q:FDD(F)=""
Q:FDD(F)="" S COLDD=FDD("C"),ROWDD=FDD("R")
S COLCUTS=CUTS("C"),ROWCUTS=CUTS("R")
I $D(ONCOS("P")) S PCT=ONCOS("P") G W
W ! S DIR("A")=" Print Percents",DIR("B")="No",DIR(0)="Y",DIR("?")="Enter 'Y' to include total percents" D ^DIR Q:Y="^"!(Y="") S PCT=Y
W U IO W !!,$S(COLDD="":"One",1:"Two"),"-Way Table with ",$P(ROWDD,U,1)_" Values"
I COLDD]"" W " for Rows ",!,"and ",$P(COLDD,U,1)," Values for Columns"
W !,"For ",$S(TEMPL:"Entries in Search Template "_HEADER,1:"ALL Cases")
Q:$D(ONCOS("Y")) S Y="OK? Yes// ",Z="" D GETYES^ONCOSINP
E G ABORT:Y=-1,S1
Q
;
GETFLD ;get field & cuts
;N F
S F=$E(FLD,1),CUTS(F)="",FDD(F)=""
I $D(ONCOS(F)) S X=$P(ONCOS(F),U,1),DIC(0)="EOQ",FDD(F)=X Q:FDD(F)=""
E S DIC(0)="AEQ",DIC("A")="Select "_FLD_" field: "
D ^DIC Q:Y="^"!(Y=-1)
S X=^DD(FNUM,+Y,0),FDD(F)=X,X=$P(X,U,2) Q:X["N"!(X["J")!(X["C")=0
I $D(ONCOS(F)) S X=$P(ONCOS(F),U,2) S:X]"" CUTS(F)=X_":99999999" Q
CUTS W !!?10,"You may enter cutpoints for this variable: "_$P(FDD(F),U)
W !?10,"E.g., enter '4:7:12:30' to count the values"
W !?10,"in 5 categories (LE 4),(GT4-LE7),...,(GT30)"
C R !!?5,"Define CUTPOINTS: ",X:DTIME G ABORT:'$T!(X="^") Q:X="" I X["?" D HLP G CUTS
CK ;Check cutpoint format
F I=1:1:$L(X) S Y=$E(X,I) I Y'?1N.N&(Y'=":") W ?50,*7,"ERROR = '"_Y_"' ~ Try Again!" G CUTS
S NC=$L(X,":") F I=1:1:NC S X(I)=$P(X,":",I) I I>2 Q:X(I)'>X(I-1)
; I I=NC F I=1:1:NC I I>2,X(I)'<X(I-1) Q
; W !!?10,"Cutpoints not properly defined",!?10,"Use increasing or decreasing numbers",!,?10,"Must have ':' as delimiter only!!" G CUTS
S CUTS(F)=X_":99999999" Q
HLP ;Help on cutpoints
W !!?10,"Cutpoints are used to partition data into groups"
W !?10,"where there is no computed field like 'AGE GROUP'."
W !?10,"Use a series of increasing or decreasing numbers"
W !?10,"separated by colons (':') to create the RANGE.",!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSCT1 2284 printed Nov 22, 2024@17:35:39 Page 2
ONCOSCT1 ;Hines OIFO/GWB - CROSS TAB SETUP ;7/27/92
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
GC ;GET CUTS
+1 ;
ABORT SET ROWDD=""
+1 QUIT
+2 ;
SETUP ;get options
+1 ;in: ^DD,^DIPT,FNUM,ONCOS,TEMPL
+2 ;out: COLCUTS,COLDD,HEADER,PCT,ROWCUTS,ROWDD
+3 ;do: ^ONCOSINP,^DIC
+4 NEW CUTS,DIC,FDD,FLD
S1 SET ROWDD=""
SET DIC="^DD("_FNUM_","
SET DIC("S")="I +$P(^(0),U,2)=0 "
+1 FOR FLD="COLUMN","ROW"
DO GETFLD
if FDD(F)=""
QUIT
+2 if FDD(F)=""
QUIT
SET COLDD=FDD("C")
SET ROWDD=FDD("R")
+3 SET COLCUTS=CUTS("C")
SET ROWCUTS=CUTS("R")
+4 IF $DATA(ONCOS("P"))
SET PCT=ONCOS("P")
GOTO W
+5 WRITE !
SET DIR("A")=" Print Percents"
SET DIR("B")="No"
SET DIR(0)="Y"
SET DIR("?")="Enter 'Y' to include total percents"
DO ^DIR
if Y="^"!(Y="")
QUIT
SET PCT=Y
W USE IO
WRITE !!,$SELECT(COLDD="":"One",1:"Two"),"-Way Table with ",$PIECE(ROWDD,U,1)_" Values"
+1 IF COLDD]""
WRITE " for Rows ",!,"and ",$PIECE(COLDD,U,1)," Values for Columns"
+2 WRITE !,"For ",$SELECT(TEMPL:"Entries in Search Template "_HEADER,1:"ALL Cases")
+3 if $DATA(ONCOS("Y"))
QUIT
SET Y="OK? Yes// "
SET Z=""
DO GETYES^ONCOSINP
+4 IF '$TEST
if Y=-1
GOTO ABORT
GOTO S1
+5 QUIT
+6 ;
GETFLD ;get field & cuts
+1 ;N F
+2 SET F=$EXTRACT(FLD,1)
SET CUTS(F)=""
SET FDD(F)=""
+3 IF $DATA(ONCOS(F))
SET X=$PIECE(ONCOS(F),U,1)
SET DIC(0)="EOQ"
SET FDD(F)=X
if FDD(F)=""
QUIT
+4 IF '$TEST
SET DIC(0)="AEQ"
SET DIC("A")="Select "_FLD_" field: "
+5 DO ^DIC
if Y="^"!(Y=-1)
QUIT
+6 SET X=^DD(FNUM,+Y,0)
SET FDD(F)=X
SET X=$PIECE(X,U,2)
if X["N"!(X["J")!(X["C")=0
QUIT
+7 IF $DATA(ONCOS(F))
SET X=$PIECE(ONCOS(F),U,2)
if X]""
SET CUTS(F)=X_":99999999"
QUIT
CUTS WRITE !!?10,"You may enter cutpoints for this variable: "_$PIECE(FDD(F),U)
+1 WRITE !?10,"E.g., enter '4:7:12:30' to count the values"
+2 WRITE !?10,"in 5 categories (LE 4),(GT4-LE7),...,(GT30)"
C READ !!?5,"Define CUTPOINTS: ",X:DTIME
if '$TEST!(X="^")
GOTO ABORT
if X=""
QUIT
IF X["?"
DO HLP
GOTO CUTS
CK ;Check cutpoint format
+1 FOR I=1:1:$LENGTH(X)
SET Y=$EXTRACT(X,I)
IF Y'?1N.N&(Y'=":")
WRITE ?50,*7,"ERROR = '"_Y_"' ~ Try Again!"
GOTO CUTS
+2 SET NC=$LENGTH(X,":")
FOR I=1:1:NC
SET X(I)=$PIECE(X,":",I)
IF I>2
if X(I)'>X(I-1)
QUIT
+3 ; I I=NC F I=1:1:NC I I>2,X(I)'<X(I-1) Q
+4 ; W !!?10,"Cutpoints not properly defined",!?10,"Use increasing or decreasing numbers",!,?10,"Must have ':' as delimiter only!!" G CUTS
+5 SET CUTS(F)=X_":99999999"
QUIT
HLP ;Help on cutpoints
+1 WRITE !!?10,"Cutpoints are used to partition data into groups"
+2 WRITE !?10,"where there is no computed field like 'AGE GROUP'."
+3 WRITE !?10,"Use a series of increasing or decreasing numbers"
+4 WRITE !?10,"separated by colons (':') to create the RANGE.",!!
+5 QUIT
