ONCOSSA2 ;WASH ISC/SRR-SURVIVAL ANALYSIS CONT-2 ;7/28/92 18:38
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
SETGRPS ;define group variables from ONCOS("G") input variable.
G:'$D(ONCOS("G")) SET1
S TIN=$P(ONCOS("G"),U,2) G SET3:TIN'="",SET1:'$D(ONCOS("G",1))
F COND=0:0 S COND=$O(ONCOS("G",COND)) Q:COND="" S Y=ONCOS("G",COND) D SET4
K ONCOS("G") S COND=0
Q
SET1 W !,"You may enter an expression that evaluates between 1 and ",NGRPS
W !,"or separate conditions for each sub-group."
S Y="Do you want to enter an expression? Yes// ",Z="" D GETYES^ONCOSINP
E G:X["?" SET1 I Y=-1 S NGRPS=1 Q
E S COND=0 G SUBGRPS
SET2 R !,"Enter sub-group expression: ",TIN:DTIME
I TIN[U S NGRPS=1 Q
SET3 D CHKCOND^ONCOSSA1 G:P SET2
S GRPEXP=TOU,COND=1 F X=1:1:NGRPS S ^TMP($J,"GRP",X)="("_TIN_") = "_X
W !,"The cases that do not evaluate between 1 and ",NGRPS," are dropped."
Q
SET4 S COND(COND)=$P(Y,U,3,99),^TMP($J,"GRP",COND)=$P(Y,U,2)
S X=+Y D SETFD^ONCOSSA1
Q
;
SUBGRPS ;get subgroups
;in: DIC,NGRPS
;out: VV,COND,^TMP($J,"GRP") - see ONCOSSA1
;do: ^DIC
N CONDCT,FLDNAM,FLDNUM,IVAL,OP,VAL S CONDCT=0
W !,"Enter truth tests that will categorize the cases into ",NGRPS," groups."
SUB1 W !,?6,"-",CONDCT+1,"- Search for field: " R X:DTIME
I X["?" W !,?6,"Enter a field name." G SUB1
SUB2 I X=""!(X[U) S NGRPS=CONDCT W !," Only ",NGRPS," sub-groups will be considered.",! Q
D ^DIC I Y<1 W *7,"???" G SUB1
S FLDNUM=+Y,FLDNAM=$P(Y,U,2)
SUB3 W !,?6,"-",CONDCT+1,"- Condition: " R X:DTIME G:X[U SUB2
S X=$E(X,1) S:X?1L X=$C($A(X)-32) S OP=$F("=><[!]EGLCMN",X)-1 S:OP>6 OP=OP-6
I 'OP W !,"Choose from EQUAL TO, LESS THAN, GREATER THAN, CONTAINS, ",!," MATCHES or NULL",! G SUB3
W " [",$P("EQUAL TO^GREATER THAN^LESS THAN^CONTAINS^MATCHES^NULL",U,OP),"]"
S OP=$E("=><[?]",OP),VAL=""
SUB4 I OP'="]" W !?6,"-",CONDCT+1,"- Value: " R VAL:DTIME G:X[U SUB2
I VAL["?" W !,"Enter a value." G SUB4
S IVAL=VAL,X=FLDNUM D SETFD^ONCOSSA1 S Y=FLDDAT(X)
I +Y&($P(Y,U,4)]"") S Y=$P(Y,U,4) F %=1:1 S X=$P(Y,";",%) Q:X="" I VAL=$P(X,":",2) S IVAL=$P(X,":",1) Q
S:IVAL'=+IVAL IVAL=""""_IVAL_"""" S:OP="]" OP="=""""",IVAL="",VAL=""
S CONDCT=CONDCT+1,COND(CONDCT)="VAL("_FLDNUM_")"_OP_IVAL
S ^TMP($J,"GRP",CONDCT)="("_FLDNAM_OP_VAL_")"
G:CONDCT<NGRPS SUB1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSSA2 2317 printed Apr 09, 2024@21:24:45 Page 2
ONCOSSA2 ;WASH ISC/SRR-SURVIVAL ANALYSIS CONT-2 ;7/28/92 18:38
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
SETGRPS ;define group variables from ONCOS("G") input variable.
+1 if '$DATA(ONCOS("G"))
GOTO SET1
+2 SET TIN=$PIECE(ONCOS("G"),U,2)
if TIN'=""
GOTO SET3
if '$DATA(ONCOS("G",1))
GOTO SET1
+3 FOR COND=0:0
SET COND=$ORDER(ONCOS("G",COND))
if COND=""
QUIT
SET Y=ONCOS("G",COND)
DO SET4
+4 KILL ONCOS("G")
SET COND=0
+5 QUIT
SET1 WRITE !,"You may enter an expression that evaluates between 1 and ",NGRPS
+1 WRITE !,"or separate conditions for each sub-group."
+2 SET Y="Do you want to enter an expression? Yes// "
SET Z=""
DO GETYES^ONCOSINP
+3 IF '$TEST
if X["?"
GOTO SET1
IF Y=-1
SET NGRPS=1
QUIT
+4 IF '$TEST
SET COND=0
GOTO SUBGRPS
SET2 READ !,"Enter sub-group expression: ",TIN:DTIME
+1 IF TIN[U
SET NGRPS=1
QUIT
SET3 DO CHKCOND^ONCOSSA1
if P
GOTO SET2
+1 SET GRPEXP=TOU
SET COND=1
FOR X=1:1:NGRPS
SET ^TMP($JOB,"GRP",X)="("_TIN_") = "_X
+2 WRITE !,"The cases that do not evaluate between 1 and ",NGRPS," are dropped."
+3 QUIT
SET4 SET COND(COND)=$PIECE(Y,U,3,99)
SET ^TMP($JOB,"GRP",COND)=$PIECE(Y,U,2)
+1 SET X=+Y
DO SETFD^ONCOSSA1
+2 QUIT
+3 ;
SUBGRPS ;get subgroups
+1 ;in: DIC,NGRPS
+2 ;out: VV,COND,^TMP($J,"GRP") - see ONCOSSA1
+3 ;do: ^DIC
+4 NEW CONDCT,FLDNAM,FLDNUM,IVAL,OP,VAL
SET CONDCT=0
+5 WRITE !,"Enter truth tests that will categorize the cases into ",NGRPS," groups."
SUB1 WRITE !,?6,"-",CONDCT+1,"- Search for field: "
READ X:DTIME
+1 IF X["?"
WRITE !,?6,"Enter a field name."
GOTO SUB1
SUB2 IF X=""!(X[U)
SET NGRPS=CONDCT
WRITE !," Only ",NGRPS," sub-groups will be considered.",!
QUIT
+1 DO ^DIC
IF Y<1
WRITE *7,"???"
GOTO SUB1
+2 SET FLDNUM=+Y
SET FLDNAM=$PIECE(Y,U,2)
SUB3 WRITE !,?6,"-",CONDCT+1,"- Condition: "
READ X:DTIME
if X[U
GOTO SUB2
+1 SET X=$EXTRACT(X,1)
if X?1L
SET X=$CHAR($ASCII(X)-32)
SET OP=$FIND("=><[!]EGLCMN",X)-1
if OP>6
SET OP=OP-6
+2 IF 'OP
WRITE !,"Choose from EQUAL TO, LESS THAN, GREATER THAN, CONTAINS, ",!," MATCHES or NULL",!
GOTO SUB3
+3 WRITE " [",$PIECE("EQUAL TO^GREATER THAN^LESS THAN^CONTAINS^MATCHES^NULL",U,OP),"]"
+4 SET OP=$EXTRACT("=><[?]",OP)
SET VAL=""
SUB4 IF OP'="]"
WRITE !?6,"-",CONDCT+1,"- Value: "
READ VAL:DTIME
if X[U
GOTO SUB2
+1 IF VAL["?"
WRITE !,"Enter a value."
GOTO SUB4
+2 SET IVAL=VAL
SET X=FLDNUM
DO SETFD^ONCOSSA1
SET Y=FLDDAT(X)
+3 IF +Y&($PIECE(Y,U,4)]"")
SET Y=$PIECE(Y,U,4)
FOR %=1:1
SET X=$PIECE(Y,";",%)
if X=""
QUIT
IF VAL=$PIECE(X,":",2)
SET IVAL=$PIECE(X,":",1)
QUIT
+4 if IVAL'=+IVAL
SET IVAL=""""_IVAL_""""
if OP="]"
SET OP="="""""
SET IVAL=""
SET VAL=""
+5 SET CONDCT=CONDCT+1
SET COND(CONDCT)="VAL("_FLDNUM_")"_OP_IVAL
+6 SET ^TMP($JOB,"GRP",CONDCT)="("_FLDNAM_OP_VAL_")"
+7 if CONDCT<NGRPS
GOTO SUB1
+8 QUIT
