ONCOST ;Hines OIFO/GWB Select ACCESSION YEAR time frame ;9/28/93
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
TF ;Select time frame
N DIRUT K DIR
S DIR("A")=" Select ACCESSION YEAR time frame"
S DIR(0)="SO^1:All years;2:Range of years;3:One year"
D ^DIR K DIR Q:$D(DIRUT)
Y S TF=Y
S BYR=$O(^ONCO(165.5,"AY",0))
S EYR=$O(^ONCO(165.5,"AY",""),-1)
D AL:TF=1,RG:TF=2,AN:TF=3 G:(Y[U)!(Y="") EXIT
I $D(ONCOT) S ONCOS("AF")=1
EXIT K DIR,BYR,EYR,TF,Y1,Y2,YR
Q
;
AL ;All years
S ONCOS("YR")="ALL"
Q
;
RG ;Range of years
N DIRUT,LY
W !!?5,"Select range of years in format (YYYY-YYYY) e.g. 2006-2007",!
ST K DIR
S DIR(0)="L^"_BYR_":"_EYR
S DIR("A")=" Select range of years"
D ^DIR Q:$D(DIRUT)
S LY=$L(Y,","),Y1=$P(Y,","),Y2=$P(Y,",",LY-1)
S ONCOS("YR")=Y1_U_Y2
Q
;
AN ;One year
N DIRUT
W !
S YR=$E(DT,1)+17_$E(DT,2,3)
K DIR
S DIR("A")=" Select ACCESSION YEAR"
S DIR("B")=$S(YR=BYR:YR,1:YR-1)
S DIR(0)="N^"_BYR_":"_EYR
D ^DIR Q:$D(DIRUT)
G AN:Y>YR,AN:Y'?1.N S ONCOS("YR")=Y_U_Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOST 1055 printed Oct 16, 2024@18:26:27 Page 2
ONCOST ;Hines OIFO/GWB Select ACCESSION YEAR time frame ;9/28/93
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
TF ;Select time frame
+1 NEW DIRUT
KILL DIR
+2 SET DIR("A")=" Select ACCESSION YEAR time frame"
+3 SET DIR(0)="SO^1:All years;2:Range of years;3:One year"
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
Y SET TF=Y
+1 SET BYR=$ORDER(^ONCO(165.5,"AY",0))
+2 SET EYR=$ORDER(^ONCO(165.5,"AY",""),-1)
+3 if TF=1
DO AL
if TF=2
DO RG
if TF=3
DO AN
if (Y[U)!(Y="")
GOTO EXIT
+4 IF $DATA(ONCOT)
SET ONCOS("AF")=1
EXIT KILL DIR,BYR,EYR,TF,Y1,Y2,YR
+1 QUIT
+2 ;
AL ;All years
+1 SET ONCOS("YR")="ALL"
+2 QUIT
+3 ;
RG ;Range of years
+1 NEW DIRUT,LY
+2 WRITE !!?5,"Select range of years in format (YYYY-YYYY) e.g. 2006-2007",!
ST KILL DIR
+1 SET DIR(0)="L^"_BYR_":"_EYR
+2 SET DIR("A")=" Select range of years"
+3 DO ^DIR
if $DATA(DIRUT)
QUIT
+4 SET LY=$LENGTH(Y,",")
SET Y1=$PIECE(Y,",")
SET Y2=$PIECE(Y,",",LY-1)
+5 SET ONCOS("YR")=Y1_U_Y2
+6 QUIT
+7 ;
AN ;One year
+1 NEW DIRUT
+2 WRITE !
+3 SET YR=$EXTRACT(DT,1)+17_$EXTRACT(DT,2,3)
+4 KILL DIR
+5 SET DIR("A")=" Select ACCESSION YEAR"
+6 SET DIR("B")=$SELECT(YR=BYR:YR,1:YR-1)
+7 SET DIR(0)="N^"_BYR_":"_EYR
+8 DO ^DIR
if $DATA(DIRUT)
QUIT
+9 if Y>YR
GOTO AN
if Y'?1.N
GOTO AN
SET ONCOS("YR")=Y_U_Y
+10 QUIT
