- 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 Feb 18, 2025@23:52:13 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
