- ONCOSCF ;WASH ISC/SRR,MLH-COMPUTED FIELDS FOR STATISTICS FILE ;8/21/93 10:40
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- ;
- FIL ;GET FILE # AND NAME
- S DIC(0)="AEQZ",DIC="^DIC(",DIC("A")=" Select File to Search: ",DIC("S")="I (Y\1=160)!((Y'<164)&(Y<170))" D ^DIC G EX:Y="^",EX:Y=-1 S $P(^ONCO(166,D0,0),U,2,3)=Y G EX ;,D="AC"
- Q
- D IX^DIC
- ROW ;GET ROW
- S FIL=$P(^ONCO(166,D0,0),U,2),DIC="^DD("_FIL_",",DIC(0)="AEQ",DIC("A")=" Select ROW field: " D ^DIC G EX:Y="^" G EX:Y=-1 S $P(^ONCO(166,D0,0),U,4,5)=Y G EX
- COL ;COLUMN NAME & NUMBER
- S FIL=$P(^ONCO(166,D0,0),U,2),DIC="^DD("_FIL_",",DIC(0)="AEQZ",DIC("A")=" Select Column field: " D ^DIC G EX:Y="^",EX:Y=-1 S $P(^ONCO(166,D0,0),U,6,7)=Y W ^(0),!
- ;
- TEM ;TEMPLATE LOOKUP
- S DIC("A")=" Select Search Template: ",DIC(0)="AEQZ",DIC="^DIBT(",D="F"_$P($G(^ONCO(166,D0,0)),U,2) G EX:D="F" D IX^DIC G EX:Y="^",EX:Y=-1 S $P(^ONCO(166,D0,0),U,8,9)=Y G EX
- EX ;EXIT
- K XX,XN,FIL,DIC
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSCF 952 printed Feb 18, 2025@23:52:02 Page 2
- ONCOSCF ;WASH ISC/SRR,MLH-COMPUTED FIELDS FOR STATISTICS FILE ;8/21/93 10:40
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- +2 ;
- FIL ;GET FILE # AND NAME
- +1 ;,D="AC"
- SET DIC(0)="AEQZ"
- SET DIC="^DIC("
- SET DIC("A")=" Select File to Search: "
- SET DIC("S")="I (Y\1=160)!((Y'<164)&(Y<170))"
- DO ^DIC
- if Y="^"
- GOTO EX
- if Y=-1
- GOTO EX
- SET $PIECE(^ONCO(166,D0,0),U,2,3)=Y
- GOTO EX
- +2 QUIT
- +3 DO IX^DIC
- ROW ;GET ROW
- +1 SET FIL=$PIECE(^ONCO(166,D0,0),U,2)
- SET DIC="^DD("_FIL_","
- SET DIC(0)="AEQ"
- SET DIC("A")=" Select ROW field: "
- DO ^DIC
- if Y="^"
- GOTO EX
- if Y=-1
- GOTO EX
- SET $PIECE(^ONCO(166,D0,0),U,4,5)=Y
- GOTO EX
- COL ;COLUMN NAME & NUMBER
- +1 SET FIL=$PIECE(^ONCO(166,D0,0),U,2)
- SET DIC="^DD("_FIL_","
- SET DIC(0)="AEQZ"
- SET DIC("A")=" Select Column field: "
- DO ^DIC
- if Y="^"
- GOTO EX
- if Y=-1
- GOTO EX
- SET $PIECE(^ONCO(166,D0,0),U,6,7)=Y
- WRITE ^(0),!
- +2 ;
- TEM ;TEMPLATE LOOKUP
- +1 SET DIC("A")=" Select Search Template: "
- SET DIC(0)="AEQZ"
- SET DIC="^DIBT("
- SET D="F"_$PIECE($GET(^ONCO(166,D0,0)),U,2)
- if D="F"
- GOTO EX
- DO IX^DIC
- if Y="^"
- GOTO EX
- if Y=-1
- GOTO EX
- SET $PIECE(^ONCO(166,D0,0),U,8,9)=Y
- GOTO EX
- EX ;EXIT
- +1 KILL XX,XN,FIL,DIC
