SDRRSLC1 ;10N20/MAH;-Generic Recall Reminder file entry selector ;12/16/2002 14:21
;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
;
RANGE(SDRRDX,SDRRDDIC,SDRRDUTIL,SDRRDFLD,SDRRDDSEL,SDRRDNUM) ;
N %DT,SDRRD,SDRRD0,SDRRDALL,SDRRDDATE,SDRRDDONE,SDRRDFL01,SDRRDFNAM,SDRRDFNUM
N SDRRDFSCR,SDRRDLAST,SDRRDLINE,SDRRDPATT,SDRRDQUIT,SDRRDVALU,SDRRDXBEG
N SDRRDXEND,SDRRDXREF,SDRRDXX,D0,DA,DIC
D FILEATTR^SDRRSLCT(SDRRDDIC,SDRRDDIC(0),.SDRRDFNUM,.SDRRDFNAM,.SDRRDFL01,.SDRRDFSCR)
S SDRRDXBEG=$P(SDRRDX,"-")
S SDRRDXEND=$P(SDRRDX,"-",2)
S (SDRRDDONE,SDRRDQUIT)=0
I SDRRDXEND']]SDRRDXBEG Q SDRRDQUIT
S SDRRDPATT=$$PATTERN(SDRRDX)
S SDRRDDATE=$S($$CHFLD^SDRRSLCT(SDRRDFNUM)["D":1,1:0)
I SDRRDDATE D Q:SDRRDDONE SDRRDQUIT
. S X=SDRRDXBEG,%DT="ST" D ^%DT S SDRRDXBEG=Y
. S X=SDRRDXEND,%DT="ST" D ^%DT S SDRRDXEND=Y
. I (SDRRDXBEG'>0)!(SDRRDXEND'>0) S SDRRDDONE=1
. Q
S SDRRD=$$ASK(SDRRDX,.SDRRDDIC,SDRRDFNAM,SDRRDFL01,"RANGE")
S SDRRDALL=$P(SDRRD,U),SDRRDQUIT=$P(SDRRD,U,2)
I SDRRDQUIT!'SDRRDALL W:'SDRRDQUIT !!,SDRRDX Q SDRRDQUIT
S SDRRDXREF="""B"""
I +SDRRDFNUM=80 D ; Kludge!
. S SDRRDXREF="""BA"""
. S SDRRDXBEG=SDRRDXBEG_" "
. S SDRRDXEND=SDRRDXEND_" "
. Q
I SDRRDDATE D
. S SDRRDXX=SDRRDXBEG-.0000001
. S SDRRDXEND=$S(SDRRDXEND'[".":SDRRDXEND+.24,1:SDRRDXEND)
. Q
E D
. S SDRRDLAST=$E(SDRRDXBEG,$L(SDRRDXBEG))
. S SDRRDLAST=$C($A(SDRRDLAST)-1)_"~"
. S SDRRDXX=$E(SDRRDXBEG,1,$L(SDRRDXBEG)-1)_SDRRDLAST
. Q
S SDRRDNUM("B4")=SDRRDNUM
F S SDRRDXX=$O(@(SDRRDDIC_SDRRDXREF_",SDRRDXX)")) Q:(SDRRDXX="")!(SDRRDXX]]SDRRDXEND) D
. S SDRRD0=0
. F S SDRRD0=$O(@(SDRRDDIC_SDRRDXREF_",SDRRDXX,SDRRD0)")) Q:SDRRD0'>0 D
.. D DATALOOP
.. Q
. Q
I SDRRDNUM=SDRRDNUM("B4")&'SDRRDDSEL D
. S SDRRD="No "_SDRRDFNAM_" "_SDRRDFL01_$$PLURAL^SDRRSLCT(SDRRDFL01)
. S SDRRD=SDRRD_" found in the range '"_SDRRDX_"'."
. D WRAP^SDRRSLCT(SDRRD,.SDRRDLINE)
. W !
. S SDRRD=0
. F S SDRRD=$O(SDRRDLINE(SDRRD)) Q:SDRRD'>0 W !,SDRRDLINE(SDRRD)
. W $C(7)
. Q
Q -1
;
ALL(SDRRDX,SDRRDDIC,SDRRDUTIL,SDRRDFLD,SDRRDDSEL,SDRRDNUM) ;
N %DT,SDRRD,SDRRD0,SDRRDALL,SDRRDDATE,SDRRDDONE,SDRRDFL01,SDRRDFNAM,SDRRDFNUM
N SDRRDFSCR,SDRRDLINE,SDRRDPATT,SDRRDQUIT,SDRRDVALU,CHAR,D0,DA,DIR,DIROUT
N DIRUT,DO,DTOUT,DUOUT,I,TEMP,X,Y
D FILEATTR^SDRRSLCT(SDRRDDIC,SDRRDDIC(0),.SDRRDFNUM,.SDRRDFNAM,.SDRRDFL01,.SDRRDFSCR)
S (SDRRDDONE,SDRRDQUIT)=0
S SDRRD=$$ASK(SDRRDX,.SDRRDDIC,SDRRDFNAM,SDRRDFL01,"PATTERN")
S SDRRDALL=$P(SDRRD,U),SDRRDQUIT=$P(SDRRD,U,2)
I SDRRDQUIT!'SDRRDALL W:'SDRRDQUIT !!,SDRRDX Q SDRRDQUIT
S SDRRDPATT=$$PATTERN(SDRRDX)
S SDRRDDATE=$S($$CHFLD^SDRRSLCT(SDRRDFNUM)["D":1,1:0)
S SDRRDNUM("B4")=SDRRDNUM
S SDRRD0=0
F S SDRRD0=$O(@(SDRRDDIC_"SDRRD0)")) Q:SDRRD0'>0 D
. D DATALOOP
. Q
I SDRRDNUM=SDRRDNUM("B4")&'SDRRDDSEL D
. S SDRRD="No "_SDRRDFNAM_" "_SDRRDFL01_$$PLURAL^SDRRSLCT(SDRRDFL01)
. S SDRRD=SDRRD_" found matching '"_SDRRDX_"'."
. D WRAP^SDRRSLCT(SDRRD,.SDRRDLINE)
. W !
. S SDRRD=0
. F S SDRRD=$O(SDRRDLINE(SDRRD)) Q:SDRRD'>0 W !,SDRRDLINE(SDRRD)
. W $C(7)
. Q
Q -1
;
PATTERN(SDRRDX) ;
N SDRRD,SDRRDCHAR,SDRRDPATT,SDRRDQUOT,SDRRDTEMP
I SDRRDX["*" D
. I SDRRDX["""" S SDRRDQUOT("""")="""""",SDRRDX=$$REPLACE^XLFSTR(SDRRDX,.SDRRDQUOT)
. S SDRRDPATT="Y'?"
. S SDRRDTEMP=""
. F SDRRD=1:1:$L(SDRRDX) D
.. S SDRRDCHAR=$E(SDRRDX,SDRRD)
.. I SDRRDCHAR'="*" S SDRRDTEMP=SDRRDTEMP_SDRRDCHAR Q
.. D PATRN(.SDRRDPATT,.SDRRDTEMP,SDRRDCHAR)
.. Q
. D PATRN(.SDRRDPATT,.SDRRDTEMP,SDRRDCHAR)
. Q
E D
. S SDRRDPATT=""
. Q
Q SDRRDPATT
;
PATRN(PAT,TEMP,CHAR) ;
I TEMP]"" S PAT=PAT_"1"""_TEMP_""""
I CHAR="*",$E(PAT,$L(PAT)-1,$L(PAT))'=".E" S PAT=PAT_".E"
S TEMP=""
Q
;
DATALOOP ;
I $$SCREEN(SDRRD0,.SDRRDDIC,$G(SDRRDFSCR))'>0 Q
S Y=$P($G(@(SDRRDDIC_"SDRRD0,0)")),U)
I Y="" Q
S Y=$$EXTERNAL^DILFD(SDRRDFNUM,.01,"",Y)
I SDRRDDATE S X=Y,%DT="ST" D ^%DT
I SDRRDX["*",SDRRDPATT]"",@SDRRDPATT Q
I SDRRDFLD="" D
. D SETDATA^SDRRSLCT(Y,SDRRD0,SDRRDUTIL,SDRRDDSEL,.SDRRDNUM)
. Q
E D
. S Y=+SDRRD0,Y(0)=$G(@(SDRRDDIC_+Y_",0)")),Y(0,0)=$P(Y(0),U)
. S SDRRDVALU=$$FLDSRT^SDRRSLCT(SDRRDFNUM,SDRRDFLD,Y(0))
. I SDRRDVALU]"" D
.. D SETDATA^SDRRSLCT(SDRRDVALU,SDRRD0,SDRRDUTIL,SDRRDDSEL,.SDRRDNUM)
.. Q
. Q
Q
;
SCREEN(SDRRD0,SDRRDDIC,SDRRDFSCR) ;
N SDRRDDONE,D0,DA,Y
S SDRRDDONE=1
I SDRRDFSCR]"" D
. D SETDIC^SDRRSLCT(.SDRRDDIC,.DIC,.DO)
. S (D0,DA,Y)=SDRRD0
. I $D(@(SDRRDDIC_"SDRRD0,0)"))#2 X SDRRDFSCR S SDRRDDONE=$T
. Q
I SDRRDDONE>0,SDRRDDIC("S")]"" D
. D SETDIC^SDRRSLCT(.SDRRDDIC,.DIC,.DO)
. S (D0,DA,Y)=SDRRD0
. I $D(@(SDRRDDIC_"SDRRD0,0)"))#2 X DIC("S") S SDRRDDONE=$T
. Q
Q SDRRDDONE
;
ASK(SDRRDX,SDRRDDIC,SDRRDFNAM,SDRRDFL01,SDRRDASKT) ;
N SDRRD,SDRRDALL,SDRRDCASE,SDRRDLINE,SDRRDQUIT,DIR,DIROUT,DIRUT,DTOUT,DUOUT
S SDRRDCASE=$$PLURAL^SDRRSLCT(SDRRDFL01)
S DIR(0)="YAO"
S SDRRD="By '"_SDRRDX_"' do you mean all "
I $$UP^XLFSTR(SDRRDX)="ALL",$G(SDRRDFSCR)="",$G(SDRRDDIC("S"))="" D
. S SDRRD=SDRRD_$P($G(@(SDRRDDIC_"0)")),U,4)_" "
. Q
S SDRRD=SDRRD_$S((SDRRDASKT="PATTERN")&(SDRRDX["*"):"matching ",1:"")
S SDRRD=SDRRD_SDRRDFNAM_" "_SDRRDFL01_SDRRDCASE
I SDRRDASKT="RANGE",SDRRDX?1.ANP1"-"1.ANP D
. S SDRRD=SDRRD_" between '"_SDRRDXBEG_"' and '"_SDRRDXEND_"'"
. Q
D WRAP^SDRRSLCT(SDRRD,.SDRRDLINE)
S SDRRD=0
F S SDRRD=$O(SDRRDLINE(SDRRD)) Q:SDRRD'>0 D
. I $O(SDRRDLINE(SDRRD))>0 S DIR("A",SDRRD)=SDRRDLINE(SDRRD)
. E S DIR("A")=SDRRDLINE(SDRRD)_": "
. Q
S DIR("B")="Yes"
S DIR("?")="Answer Y(es) if you want all of the "_SDRRDFNAM_" "
S DIR("?")=DIR("?")_SDRRDFL01_SDRRDCASE_", otherwise answer N(o)."
W ! D ^DIR S SDRRDALL=+$G(Y)
S SDRRDQUIT=$S($D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT):1,1:0)
Q SDRRDALL_U_SDRRDQUIT
;
INTERNAL(SDRRDIN,SDRRDOUT) ;
; Copy @SDRRDIN@(External,Internal) to @SDRRDOUT@(Internal)
N SDRRDEXT,SDRRDINT
S SDRRDEXT=""
F S SDRRDEXT=$O(@SDRRDIN@(SDRRDEXT)) Q:SDRRDEXT="" D
. S SDRRDINT=""
. F S SDRRDINT=$O(@SDRRDIN@(SDRRDEXT,SDRRDINT)) Q:SDRRDINT="" D
.. S @SDRRDOUT@(SDRRDINT)=""
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRSLC1 6120 printed Oct 16, 2024@19:01:20 Page 2
SDRRSLC1 ;10N20/MAH;-Generic Recall Reminder file entry selector ;12/16/2002 14:21
+1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
+2 ;
RANGE(SDRRDX,SDRRDDIC,SDRRDUTIL,SDRRDFLD,SDRRDDSEL,SDRRDNUM) ;
+1 NEW %DT,SDRRD,SDRRD0,SDRRDALL,SDRRDDATE,SDRRDDONE,SDRRDFL01,SDRRDFNAM,SDRRDFNUM
+2 NEW SDRRDFSCR,SDRRDLAST,SDRRDLINE,SDRRDPATT,SDRRDQUIT,SDRRDVALU,SDRRDXBEG
+3 NEW SDRRDXEND,SDRRDXREF,SDRRDXX,D0,DA,DIC
+4 DO FILEATTR^SDRRSLCT(SDRRDDIC,SDRRDDIC(0),.SDRRDFNUM,.SDRRDFNAM,.SDRRDFL01,.SDRRDFSCR)
+5 SET SDRRDXBEG=$PIECE(SDRRDX,"-")
+6 SET SDRRDXEND=$PIECE(SDRRDX,"-",2)
+7 SET (SDRRDDONE,SDRRDQUIT)=0
+8 IF SDRRDXEND']]SDRRDXBEG
QUIT SDRRDQUIT
+9 SET SDRRDPATT=$$PATTERN(SDRRDX)
+10 SET SDRRDDATE=$SELECT($$CHFLD^SDRRSLCT(SDRRDFNUM)["D":1,1:0)
+11 IF SDRRDDATE
Begin DoDot:1
+12 SET X=SDRRDXBEG
SET %DT="ST"
DO ^%DT
SET SDRRDXBEG=Y
+13 SET X=SDRRDXEND
SET %DT="ST"
DO ^%DT
SET SDRRDXEND=Y
+14 IF (SDRRDXBEG'>0)!(SDRRDXEND'>0)
SET SDRRDDONE=1
+15 QUIT
End DoDot:1
if SDRRDDONE
QUIT SDRRDQUIT
+16 SET SDRRD=$$ASK(SDRRDX,.SDRRDDIC,SDRRDFNAM,SDRRDFL01,"RANGE")
+17 SET SDRRDALL=$PIECE(SDRRD,U)
SET SDRRDQUIT=$PIECE(SDRRD,U,2)
+18 IF SDRRDQUIT!'SDRRDALL
if 'SDRRDQUIT
WRITE !!,SDRRDX
QUIT SDRRDQUIT
+19 SET SDRRDXREF="""B"""
+20 ; Kludge!
IF +SDRRDFNUM=80
Begin DoDot:1
+21 SET SDRRDXREF="""BA"""
+22 SET SDRRDXBEG=SDRRDXBEG_" "
+23 SET SDRRDXEND=SDRRDXEND_" "
+24 QUIT
End DoDot:1
+25 IF SDRRDDATE
Begin DoDot:1
+26 SET SDRRDXX=SDRRDXBEG-.0000001
+27 SET SDRRDXEND=$SELECT(SDRRDXEND'[".":SDRRDXEND+.24,1:SDRRDXEND)
+28 QUIT
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET SDRRDLAST=$EXTRACT(SDRRDXBEG,$LENGTH(SDRRDXBEG))
+31 SET SDRRDLAST=$CHAR($ASCII(SDRRDLAST)-1)_"~"
+32 SET SDRRDXX=$EXTRACT(SDRRDXBEG,1,$LENGTH(SDRRDXBEG)-1)_SDRRDLAST
+33 QUIT
End DoDot:1
+34 SET SDRRDNUM("B4")=SDRRDNUM
+35 FOR
SET SDRRDXX=$ORDER(@(SDRRDDIC_SDRRDXREF_",SDRRDXX)"))
if (SDRRDXX="")!(SDRRDXX]]SDRRDXEND)
QUIT
Begin DoDot:1
+36 SET SDRRD0=0
+37 FOR
SET SDRRD0=$ORDER(@(SDRRDDIC_SDRRDXREF_",SDRRDXX,SDRRD0)"))
if SDRRD0'>0
QUIT
Begin DoDot:2
+38 DO DATALOOP
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 IF SDRRDNUM=SDRRDNUM("B4")&'SDRRDDSEL
Begin DoDot:1
+42 SET SDRRD="No "_SDRRDFNAM_" "_SDRRDFL01_$$PLURAL^SDRRSLCT(SDRRDFL01)
+43 SET SDRRD=SDRRD_" found in the range '"_SDRRDX_"'."
+44 DO WRAP^SDRRSLCT(SDRRD,.SDRRDLINE)
+45 WRITE !
+46 SET SDRRD=0
+47 FOR
SET SDRRD=$ORDER(SDRRDLINE(SDRRD))
if SDRRD'>0
QUIT
WRITE !,SDRRDLINE(SDRRD)
+48 WRITE $CHAR(7)
+49 QUIT
End DoDot:1
+50 QUIT -1
+51 ;
ALL(SDRRDX,SDRRDDIC,SDRRDUTIL,SDRRDFLD,SDRRDDSEL,SDRRDNUM) ;
+1 NEW %DT,SDRRD,SDRRD0,SDRRDALL,SDRRDDATE,SDRRDDONE,SDRRDFL01,SDRRDFNAM,SDRRDFNUM
+2 NEW SDRRDFSCR,SDRRDLINE,SDRRDPATT,SDRRDQUIT,SDRRDVALU,CHAR,D0,DA,DIR,DIROUT
+3 NEW DIRUT,DO,DTOUT,DUOUT,I,TEMP,X,Y
+4 DO FILEATTR^SDRRSLCT(SDRRDDIC,SDRRDDIC(0),.SDRRDFNUM,.SDRRDFNAM,.SDRRDFL01,.SDRRDFSCR)
+5 SET (SDRRDDONE,SDRRDQUIT)=0
+6 SET SDRRD=$$ASK(SDRRDX,.SDRRDDIC,SDRRDFNAM,SDRRDFL01,"PATTERN")
+7 SET SDRRDALL=$PIECE(SDRRD,U)
SET SDRRDQUIT=$PIECE(SDRRD,U,2)
+8 IF SDRRDQUIT!'SDRRDALL
if 'SDRRDQUIT
WRITE !!,SDRRDX
QUIT SDRRDQUIT
+9 SET SDRRDPATT=$$PATTERN(SDRRDX)
+10 SET SDRRDDATE=$SELECT($$CHFLD^SDRRSLCT(SDRRDFNUM)["D":1,1:0)
+11 SET SDRRDNUM("B4")=SDRRDNUM
+12 SET SDRRD0=0
+13 FOR
SET SDRRD0=$ORDER(@(SDRRDDIC_"SDRRD0)"))
if SDRRD0'>0
QUIT
Begin DoDot:1
+14 DO DATALOOP
+15 QUIT
End DoDot:1
+16 IF SDRRDNUM=SDRRDNUM("B4")&'SDRRDDSEL
Begin DoDot:1
+17 SET SDRRD="No "_SDRRDFNAM_" "_SDRRDFL01_$$PLURAL^SDRRSLCT(SDRRDFL01)
+18 SET SDRRD=SDRRD_" found matching '"_SDRRDX_"'."
+19 DO WRAP^SDRRSLCT(SDRRD,.SDRRDLINE)
+20 WRITE !
+21 SET SDRRD=0
+22 FOR
SET SDRRD=$ORDER(SDRRDLINE(SDRRD))
if SDRRD'>0
QUIT
WRITE !,SDRRDLINE(SDRRD)
+23 WRITE $CHAR(7)
+24 QUIT
End DoDot:1
+25 QUIT -1
+26 ;
PATTERN(SDRRDX) ;
+1 NEW SDRRD,SDRRDCHAR,SDRRDPATT,SDRRDQUOT,SDRRDTEMP
+2 IF SDRRDX["*"
Begin DoDot:1
+3 IF SDRRDX[""""
SET SDRRDQUOT("""")=""""""
SET SDRRDX=$$REPLACE^XLFSTR(SDRRDX,.SDRRDQUOT)
+4 SET SDRRDPATT="Y'?"
+5 SET SDRRDTEMP=""
+6 FOR SDRRD=1:1:$LENGTH(SDRRDX)
Begin DoDot:2
+7 SET SDRRDCHAR=$EXTRACT(SDRRDX,SDRRD)
+8 IF SDRRDCHAR'="*"
SET SDRRDTEMP=SDRRDTEMP_SDRRDCHAR
QUIT
+9 DO PATRN(.SDRRDPATT,.SDRRDTEMP,SDRRDCHAR)
+10 QUIT
End DoDot:2
+11 DO PATRN(.SDRRDPATT,.SDRRDTEMP,SDRRDCHAR)
+12 QUIT
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET SDRRDPATT=""
+15 QUIT
End DoDot:1
+16 QUIT SDRRDPATT
+17 ;
PATRN(PAT,TEMP,CHAR) ;
+1 IF TEMP]""
SET PAT=PAT_"1"""_TEMP_""""
+2 IF CHAR="*"
IF $EXTRACT(PAT,$LENGTH(PAT)-1,$LENGTH(PAT))'=".E"
SET PAT=PAT_".E"
+3 SET TEMP=""
+4 QUIT
+5 ;
DATALOOP ;
+1 IF $$SCREEN(SDRRD0,.SDRRDDIC,$GET(SDRRDFSCR))'>0
QUIT
+2 SET Y=$PIECE($GET(@(SDRRDDIC_"SDRRD0,0)")),U)
+3 IF Y=""
QUIT
+4 SET Y=$$EXTERNAL^DILFD(SDRRDFNUM,.01,"",Y)
+5 IF SDRRDDATE
SET X=Y
SET %DT="ST"
DO ^%DT
+6 IF SDRRDX["*"
IF SDRRDPATT]""
IF @SDRRDPATT
QUIT
+7 IF SDRRDFLD=""
Begin DoDot:1
+8 DO SETDATA^SDRRSLCT(Y,SDRRD0,SDRRDUTIL,SDRRDDSEL,.SDRRDNUM)
+9 QUIT
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET Y=+SDRRD0
SET Y(0)=$GET(@(SDRRDDIC_+Y_",0)"))
SET Y(0,0)=$PIECE(Y(0),U)
+12 SET SDRRDVALU=$$FLDSRT^SDRRSLCT(SDRRDFNUM,SDRRDFLD,Y(0))
+13 IF SDRRDVALU]""
Begin DoDot:2
+14 DO SETDATA^SDRRSLCT(SDRRDVALU,SDRRD0,SDRRDUTIL,SDRRDDSEL,.SDRRDNUM)
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
SCREEN(SDRRD0,SDRRDDIC,SDRRDFSCR) ;
+1 NEW SDRRDDONE,D0,DA,Y
+2 SET SDRRDDONE=1
+3 IF SDRRDFSCR]""
Begin DoDot:1
+4 DO SETDIC^SDRRSLCT(.SDRRDDIC,.DIC,.DO)
+5 SET (D0,DA,Y)=SDRRD0
+6 IF $DATA(@(SDRRDDIC_"SDRRD0,0)"))#2
XECUTE SDRRDFSCR
SET SDRRDDONE=$TEST
+7 QUIT
End DoDot:1
+8 IF SDRRDDONE>0
IF SDRRDDIC("S")]""
Begin DoDot:1
+9 DO SETDIC^SDRRSLCT(.SDRRDDIC,.DIC,.DO)
+10 SET (D0,DA,Y)=SDRRD0
+11 IF $DATA(@(SDRRDDIC_"SDRRD0,0)"))#2
XECUTE DIC("S")
SET SDRRDDONE=$TEST
+12 QUIT
End DoDot:1
+13 QUIT SDRRDDONE
+14 ;
ASK(SDRRDX,SDRRDDIC,SDRRDFNAM,SDRRDFL01,SDRRDASKT) ;
+1 NEW SDRRD,SDRRDALL,SDRRDCASE,SDRRDLINE,SDRRDQUIT,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 SET SDRRDCASE=$$PLURAL^SDRRSLCT(SDRRDFL01)
+3 SET DIR(0)="YAO"
+4 SET SDRRD="By '"_SDRRDX_"' do you mean all "
+5 IF $$UP^XLFSTR(SDRRDX)="ALL"
IF $GET(SDRRDFSCR)=""
IF $GET(SDRRDDIC("S"))=""
Begin DoDot:1
+6 SET SDRRD=SDRRD_$PIECE($GET(@(SDRRDDIC_"0)")),U,4)_" "
+7 QUIT
End DoDot:1
+8 SET SDRRD=SDRRD_$SELECT((SDRRDASKT="PATTERN")&(SDRRDX["*"):"matching ",1:"")
+9 SET SDRRD=SDRRD_SDRRDFNAM_" "_SDRRDFL01_SDRRDCASE
+10 IF SDRRDASKT="RANGE"
IF SDRRDX?1.ANP1"-"1.ANP
Begin DoDot:1
+11 SET SDRRD=SDRRD_" between '"_SDRRDXBEG_"' and '"_SDRRDXEND_"'"
+12 QUIT
End DoDot:1
+13 DO WRAP^SDRRSLCT(SDRRD,.SDRRDLINE)
+14 SET SDRRD=0
+15 FOR
SET SDRRD=$ORDER(SDRRDLINE(SDRRD))
if SDRRD'>0
QUIT
Begin DoDot:1
+16 IF $ORDER(SDRRDLINE(SDRRD))>0
SET DIR("A",SDRRD)=SDRRDLINE(SDRRD)
+17 IF '$TEST
SET DIR("A")=SDRRDLINE(SDRRD)_": "
+18 QUIT
End DoDot:1
+19 SET DIR("B")="Yes"
+20 SET DIR("?")="Answer Y(es) if you want all of the "_SDRRDFNAM_" "
+21 SET DIR("?")=DIR("?")_SDRRDFL01_SDRRDCASE_", otherwise answer N(o)."
+22 WRITE !
DO ^DIR
SET SDRRDALL=+$GET(Y)
+23 SET SDRRDQUIT=$SELECT($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DIRUT):1,1:0)
+24 QUIT SDRRDALL_U_SDRRDQUIT
+25 ;
INTERNAL(SDRRDIN,SDRRDOUT) ;
+1 ; Copy @SDRRDIN@(External,Internal) to @SDRRDOUT@(Internal)
+2 NEW SDRRDEXT,SDRRDINT
+3 SET SDRRDEXT=""
+4 FOR
SET SDRRDEXT=$ORDER(@SDRRDIN@(SDRRDEXT))
if SDRRDEXT=""
QUIT
Begin DoDot:1
+5 SET SDRRDINT=""
+6 FOR
SET SDRRDINT=$ORDER(@SDRRDIN@(SDRRDEXT,SDRRDINT))
if SDRRDINT=""
QUIT
Begin DoDot:2
+7 SET @SDRRDOUT@(SDRRDINT)=""
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
