SDWLRPS1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1-SUMMARY ;1/5/16 3:40pm
;;5.3;scheduling;**263,412,645**;AUG 13 1993;Build 7
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
;
;
EN ;
D INIT
I $$S^%ZTLOAD G END
D HD
D SORT
I $$S^%ZTLOAD G END
D PRT
I $D(DUOUT) W !!,"*** End of Report ***" G END
G:POP END
I $$S^%ZTLOAD G END
D PRT1
W !!,"*** End of Report ***"
K ^TMP("SDWLRPS1",$J)
Q
INIT ;Initialize variables
;
I $D(CT1) S SDWLCT1=CT1
I $D(CT2) S SDWLCT2=CT2
I $D(DATE) S SDWLDATE=DATE
I $D(FORM) S SDWLFORM=FORM
I $D(INS) S SDWLINS=INS
I $D(OPEN) S SDWLOPEN=OPEN
S SDWLPG=0
I $D(ZTSAVE) D
.F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI))
I SDWLINS="ALL" S SDWLIN("ALL")=""
S SDWLTXP=$P(SDWLCT1,U,3)
S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C")
I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)="",^TMP("SDWLRPT1",$J,$P(^DIC(4,SDWLIN,0),U,1))=0
I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)=""
I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1
S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2)
N POP S POP=0 ;SD*5.3*412
INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
Q
SORT ;Sort Records
K ^TMP("SDWLRPS1",$J)
S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
.S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX,SDWLDDT=$P(SDWLX,U,16)
.;-Check for Institution Sort
.I SDWLINS'="ALL" D
..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q
.;-Check for Date Range Compliance
.I $P(SDWLX,U,16)<SDWLBD!($P(SDWLX,U,16)>SDWLED) S SDWLERR=2 Q
.S SDWLAPDT=$P(SDWLX,U,16),SDWLOPDT=$P(SDWLX,U,2) S X1=DT,X2=SDWLAPDT D ^%DTC S SDWLDWT=X I SDWLDWT<0 S SDWLDWT=0
.S SDWLTYP=$P(SDWLCT1,U,1),SDWLTYPE=$S(SDWLTYP="C":$P(SDWLX,U,9),1:$P(SDWLX,U,8)) I SDWLTYPE="" S SDWLERR=7 Q
.S SDWLF=$P(SDWLCT1,U,2)
.I SDWLCT2'="ALL" D
..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
.I SDWLTYP="" S SDWLERR=4 Q
.I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q
.Q:SDWLERR D
..S SDWLSCC=2,DFN=SDWLDFN D ELIG^VADPT I $D(VAEL(3)) S SDWLSCN=$P(VAEL(3),U,2) I SDWLSCN>49 S SDWLSCC=1
..S:'$D(^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)) ^(SDWLTYPE)=0
..S ^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
..S:'$D(^TMP("SDWLRPS1",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)) ^(SDWLDFN)=0 S ^TMP("SDWLRPS1",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)=^(SDWLDFN)+1
..S:'$D(^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)) ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=0
..S ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
..S ^TMP("SDWLRPS1",$J,"D",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE,+SDWLDWT,SDWLDA)=""
Q
PRT ;
I '$D(^TMP("SDWLRPS1",$J,"A")) W !!,"*** No Patients to Report ***" S DUOUT="" Q
S SDWLIN=0 F S SDWLIN=$O(^TMP("SDWLRPS1",$J,"A",SDWLIN)) Q:SDWLIN="" W !,"Institution: ",$P($G(^DIC(4,SDWLIN,0)),U,1),! D Q:POP ;SD*5.3*412
.D PRA
Q
PRA ;
S SDWLSC=0,(SDWLX,SDWLXT)=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"A",SDWLIN,SDWLSC)) Q:SDWLSC="" D
.S SDWLX=$G(^TMP("SDWLRPS1",$J,"A",SDWLIN,SDWLSC)),SDWLXT=SDWLXT+SDWLX W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1)),?30,SDWLX
.S SDWLXTT=0,SDWLDFNX=0 F S SDWLDFNX=$O(^TMP("SDWLRPS1",$J,"B",SDWLIN,SDWLSC,SDWLDFNX)) Q:SDWLDFNX="" S SDWLXTT=SDWLXTT+1
W !,?20,"Total #: ",SDWLXT
I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP ;SD*5.3*412 early exit
Q
PRT1 ;
N DFN
D HD1
S SDWLSCC=0 F S SDWLSCC=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC)) Q:SDWLSCC="" Q:$$S^%ZTLOAD D Q:POP ;SD*5.3*412 added to allow early exit
.W !,"******* ",SDWLSCC," *******",!
.S SDWLINS=0 F S SDWLINS=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS)) Q:SDWLINS="" D Q:POP W ! ;SD*5.3*412
..W !,$P($G(^DIC(4,SDWLINS,0)),U,1)
..S SDWLSC=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC)) Q:SDWLSC="" D Q:POP ;SD*5.3*412
...W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1))
...S SDWLWT="" F S SDWLWT=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT)) Q:SDWLWT="" D Q:POP ;SD*5.3*412
....S SDWLDA=0 F S SDWLDA=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT,SDWLDA)) Q:SDWLDA="" D Q:POP ;SD*5.3*412
.....S X=$G(^SDWL(409.3,SDWLDA,0)),SDWLODT=$P(X,U,2),SDWLDDT=$P(X,U,16) S DFN=+X D Q:POP ;SD*5.3*412
......D DEM^VADPT,1^VADPT K DFN
......W !,VA("BID"),?6,$E(VADM(1),1,25) W ?32,$E(SDWLODT,4,5),"/",$E(SDWLODT,6,7),"/",($E(SDWLODT,1,3)+1700)
......W ?47,$E(SDWLDDT,4,5),"/",$E(SDWLDDT,6,7),"/",($E(SDWLDDT,1,3)+1700),?60,$J(SDWLWT,5)
......I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP D HD1
......I $Y>IOSL D HD
.W !
LINE ;Draw Line
W !,"_______________________________________________________________________________"
Q
HD ;Header
W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG
W !!,?30,"Institution: " I SDWLINS="ALL" D
.W ?45,SDWLINS
F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X
S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y
; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'
;W !,?23,"Date Desired Range: ",SDWLBDT," to ",SDWLEDT
W !,?18,"CID/Preferred Date Range: ",SDWLBDT," to ",SDWLEDT
S X=$P(SDWLCT2,U,2)
W !?27,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL"
I X'="ALL" D
.F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X)
S X=$G(SDWLOPEN) W !,?36,"Status: ",$S(SDWLOPEN="O":"Open",1:"All")
S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
W !
Q
HD1 ;
W:$D(IOF) @IOF
; SD*5.3*645 - replaced 'Date Desired' with 'CID/PD' and adjusted format
;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!
W !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",!
END K X1,X2,CT1,CT2,DATE,I,INS,OPEN,FORM
K ^TMP("SDWLRPT1",$J) Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRPS1 6442 printed Apr 09, 2024@21:51:35 Page 2
SDWLRPS1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1-SUMMARY ;1/5/16 3:40pm
+1 ;;5.3;scheduling;**263,412,645**;AUG 13 1993;Build 7
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ;
+12 ;
EN ;
+1 DO INIT
+2 IF $$S^%ZTLOAD
GOTO END
+3 DO HD
+4 DO SORT
+5 IF $$S^%ZTLOAD
GOTO END
+6 DO PRT
+7 IF $DATA(DUOUT)
WRITE !!,"*** End of Report ***"
GOTO END
+8 if POP
GOTO END
+9 IF $$S^%ZTLOAD
GOTO END
+10 DO PRT1
+11 WRITE !!,"*** End of Report ***"
+12 KILL ^TMP("SDWLRPS1",$JOB)
+13 QUIT
INIT ;Initialize variables
+1 ;
+2 IF $DATA(CT1)
SET SDWLCT1=CT1
+3 IF $DATA(CT2)
SET SDWLCT2=CT2
+4 IF $DATA(DATE)
SET SDWLDATE=DATE
+5 IF $DATA(FORM)
SET SDWLFORM=FORM
+6 IF $DATA(INS)
SET SDWLINS=INS
+7 IF $DATA(OPEN)
SET SDWLOPEN=OPEN
+8 SET SDWLPG=0
+9 IF $DATA(ZTSAVE)
Begin DoDot:1
+10 FOR SDWLI="CT1","CT2","DATE","FORM","INS","OPEN"
SET SDWL="SDWL"_SDWLI
SET @SDWL=$GET(ZTSAVE(SDWLI))
End DoDot:1
+11 IF SDWLINS="ALL"
SET SDWLIN("ALL")=""
+12 SET SDWLTXP=$PIECE(SDWLCT1,U,3)
+13 SET SDWLOPEN=$SELECT(SDWLOPEN=1:"O",1:"C")
+14 IF SDWLINS'="ALL"
FOR SDWLI=1:1
SET SDWLIN=$PIECE($PIECE(SDWLINS,";",SDWLI),U,1)
if SDWLIN=""
QUIT
SET SDWLIN(SDWLIN)=""
SET ^TMP("SDWLRPT1",$JOB,$PIECE(^DIC(4,SDWLIN,0),U,1))=0
+15 IF SDWLCT2'="ALL"
FOR SDWLI=1:1
SET SDWLCT=$PIECE($PIECE(SDWLCT2,";",SDWLI),U,1)
if SDWLCT=""
QUIT
SET SDWLCT2(SDWLCT)=""
+16 IF SDWLDATE="ALL"
SET SDWLBD=0
SET SDWLED=9999999
GOTO INIT1
+17 SET SDWLBD=$PIECE(SDWLDATE,U,1)
SET SDWLED=$PIECE(SDWLDATE,U,2)
+18 ;SD*5.3*412
NEW POP
SET POP=0
INIT1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET SDWLDTP=$PIECE(Y,":",1,2)
+1 QUIT
SORT ;Sort Records
+1 KILL ^TMP("SDWLRPS1",$JOB)
+2 SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^SDWL(409.3,SDWLDA))
if SDWLDA<1
QUIT
Begin DoDot:1
+3 SET SDWLX=$GET(^SDWL(409.3,SDWLDA,0))
SET SDWLERR=0
SET SDWLDFN=+SDWLX
SET SDWLDDT=$PIECE(SDWLX,U,16)
+4 ;-Check for Institution Sort
+5 IF SDWLINS'="ALL"
Begin DoDot:2
+6 IF '$DATA(SDWLIN(+$PIECE(SDWLX,U,3)))
SET SDWLERR=1
QUIT
End DoDot:2
+7 ;-Check for Date Range Compliance
+8 IF $PIECE(SDWLX,U,16)<SDWLBD!($PIECE(SDWLX,U,16)>SDWLED)
SET SDWLERR=2
QUIT
+9 SET SDWLAPDT=$PIECE(SDWLX,U,16)
SET SDWLOPDT=$PIECE(SDWLX,U,2)
SET X1=DT
SET X2=SDWLAPDT
DO ^%DTC
SET SDWLDWT=X
IF SDWLDWT<0
SET SDWLDWT=0
+10 SET SDWLTYP=$PIECE(SDWLCT1,U,1)
SET SDWLTYPE=$SELECT(SDWLTYP="C":$PIECE(SDWLX,U,9),1:$PIECE(SDWLX,U,8))
IF SDWLTYPE=""
SET SDWLERR=7
QUIT
+11 SET SDWLF=$PIECE(SDWLCT1,U,2)
+12 IF SDWLCT2'="ALL"
Begin DoDot:2
+13 IF '$DATA(SDWLCT2(SDWLTYPE))
SET SDWLERR=3
End DoDot:2
+14 IF SDWLTYP=""
SET SDWLERR=4
QUIT
+15 IF SDWLOPEN'["C"
IF $PIECE(SDWLX,U,17)'[SDWLOPEN
SET SDWLERR=6
QUIT
+16 if SDWLERR
QUIT
Begin DoDot:2
+17 SET SDWLSCC=2
SET DFN=SDWLDFN
DO ELIG^VADPT
IF $DATA(VAEL(3))
SET SDWLSCN=$PIECE(VAEL(3),U,2)
IF SDWLSCN>49
SET SDWLSCC=1
+18 if '$DATA(^TMP("SDWLRPS1",$JOB,"A",+$PIECE(SDWLX,U,3),SDWLTYPE))
SET ^(SDWLTYPE)=0
+19 SET ^TMP("SDWLRPS1",$JOB,"A",+$PIECE(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
+20 if '$DATA(^TMP("SDWLRPS1",$JOB,"B",+$PIECE(SDWLX,U,3),SDWLTYPE,SDWLDFN))
SET ^(SDWLDFN)=0
SET ^TMP("SDWLRPS1",$JOB,"B",+$PIECE(SDWLX,U,3),SDWLTYPE,SDWLDFN)=^(SDWLDFN)+1
+21 if '$DATA(^TMP("SDWLRPS1",$JOB,"C",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE))
SET ^TMP("SDWLRPS1",$JOB,"C",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE)=0
+22 SET ^TMP("SDWLRPS1",$JOB,"C",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
+23 SET ^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE,+SDWLDWT,SDWLDA)=""
End DoDot:2
End DoDot:1
+24 QUIT
PRT ;
+1 IF '$DATA(^TMP("SDWLRPS1",$JOB,"A"))
WRITE !!,"*** No Patients to Report ***"
SET DUOUT=""
QUIT
+2 ;SD*5.3*412
SET SDWLIN=0
FOR
SET SDWLIN=$ORDER(^TMP("SDWLRPS1",$JOB,"A",SDWLIN))
if SDWLIN=""
QUIT
WRITE !,"Institution: ",$PIECE($GET(^DIC(4,SDWLIN,0)),U,1),!
Begin DoDot:1
+3 DO PRA
End DoDot:1
if POP
QUIT
+4 QUIT
PRA ;
+1 SET SDWLSC=0
SET (SDWLX,SDWLXT)=0
FOR
SET SDWLSC=$ORDER(^TMP("SDWLRPS1",$JOB,"A",SDWLIN,SDWLSC))
if SDWLSC=""
QUIT
Begin DoDot:1
+2 SET SDWLX=$GET(^TMP("SDWLRPS1",$JOB,"A",SDWLIN,SDWLSC))
SET SDWLXT=SDWLXT+SDWLX
WRITE !,$$EXTERNAL^DILFD(SDWLF,.01,,$PIECE(^SDWL(SDWLF,SDWLSC,0),U,1)),?30,SDWLX
+3 SET SDWLXTT=0
SET SDWLDFNX=0
FOR
SET SDWLDFNX=$ORDER(^TMP("SDWLRPS1",$JOB,"B",SDWLIN,SDWLSC,SDWLDFNX))
if SDWLDFNX=""
QUIT
SET SDWLXTT=SDWLXTT+1
End DoDot:1
+4 WRITE !,?20,"Total #: ",SDWLXT
+5 ;SD*5.3*412 early exit
IF $DATA(SDWLSPT)
IF $Y>IOSL
SET DIR(0)="E"
DO ^DIR
if X="^"
SET POP=1
if POP
QUIT
+6 QUIT
PRT1 ;
+1 NEW DFN
+2 DO HD1
+3 ;SD*5.3*412 added to allow early exit
SET SDWLSCC=0
FOR
SET SDWLSCC=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC))
if SDWLSCC=""
QUIT
if $$S^%ZTLOAD
QUIT
Begin DoDot:1
+4 WRITE !,"******* ",SDWLSCC," *******",!
+5 ;SD*5.3*412
SET SDWLINS=0
FOR
SET SDWLINS=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS))
if SDWLINS=""
QUIT
Begin DoDot:2
+6 WRITE !,$PIECE($GET(^DIC(4,SDWLINS,0)),U,1)
+7 ;SD*5.3*412
SET SDWLSC=0
FOR
SET SDWLSC=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS,SDWLSC))
if SDWLSC=""
QUIT
Begin DoDot:3
+8 WRITE !,$$EXTERNAL^DILFD(SDWLF,.01,,$PIECE(^SDWL(SDWLF,SDWLSC,0),U,1))
+9 ;SD*5.3*412
SET SDWLWT=""
FOR
SET SDWLWT=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT))
if SDWLWT=""
QUIT
Begin DoDot:4
+10 ;SD*5.3*412
SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT,SDWLDA))
if SDWLDA=""
QUIT
Begin DoDot:5
+11 ;SD*5.3*412
SET X=$GET(^SDWL(409.3,SDWLDA,0))
SET SDWLODT=$PIECE(X,U,2)
SET SDWLDDT=$PIECE(X,U,16)
SET DFN=+X
Begin DoDot:6
+12 DO DEM^VADPT
DO 1^VADPT
KILL DFN
+13 WRITE !,VA("BID"),?6,$EXTRACT(VADM(1),1,25)
WRITE ?32,$EXTRACT(SDWLODT,4,5),"/",$EXTRACT(SDWLODT,6,7),"/",($EXTRACT(SDWLODT,1,3)+1700)
+14 WRITE ?47,$EXTRACT(SDWLDDT,4,5),"/",$EXTRACT(SDWLDDT,6,7),"/",($EXTRACT(SDWLDDT,1,3)+1700),?60,$JUSTIFY(SDWLWT,5)
+15 IF $DATA(SDWLSPT)
IF $Y>IOSL
SET DIR(0)="E"
DO ^DIR
if X="^"
SET POP=1
if POP
QUIT
DO HD1
+16 IF $Y>IOSL
DO HD
End DoDot:6
if POP
QUIT
End DoDot:5
if POP
QUIT
End DoDot:4
if POP
QUIT
End DoDot:3
if POP
QUIT
End DoDot:2
if POP
QUIT
WRITE !
+17 WRITE !
End DoDot:1
if POP
QUIT
LINE ;Draw Line
+1 WRITE !,"_______________________________________________________________________________"
+2 QUIT
HD ;Header
+1 if $DATA(IOF)
WRITE @IOF
WRITE !,SDWLDTP,?80-$LENGTH("Appointment Wait List Report")\2,"Appointment Wait List Report"
+2 SET SDWLPG=SDWLPG+1
WRITE ?72,"Page: ",SDWLPG
+3 WRITE !!,?30,"Institution: "
IF SDWLINS="ALL"
Begin DoDot:1
+4 WRITE ?45,SDWLINS
End DoDot:1
+5 FOR I=1:1
SET X=$PIECE($PIECE(SDWLINS,";",I),"^",2)
if X=""
QUIT
if I>1
WRITE !
WRITE ?45,X
+6 SET Y=$PIECE(SDWLDATE,U,1)
DO DD^%DT
SET SDWLBDT=Y
SET Y=$PIECE(SDWLDATE,U,2)
DO DD^%DT
SET SDWLEDT=Y
+7 ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'
+8 ;W !,?23,"Date Desired Range: ",SDWLBDT," to ",SDWLEDT
+9 WRITE !,?18,"CID/Preferred Date Range: ",SDWLBDT," to ",SDWLEDT
+10 SET X=$PIECE(SDWLCT2,U,2)
+11 WRITE !?27,"Report Category: ",$SELECT($PIECE(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY")
IF X="ALL"
WRITE " ALL"
+12 IF X'="ALL"
Begin DoDot:1
+13 FOR I=1:1
SET X=$PIECE($PIECE(SDWLCT2,";",I),"^",2)
if X=""
QUIT
WRITE !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X)
End DoDot:1
+14 SET X=$GET(SDWLOPEN)
WRITE !,?36,"Status: ",$SELECT(SDWLOPEN="O":"Open",1:"All")
+15 SET X=$GET(SDWLFORM)
WRITE !,?28,"Output Format: ",$SELECT(SDWLFORM="S":"Summary",1:"Detailed")
+16 WRITE !
+17 QUIT
HD1 ;
+1 if $DATA(IOF)
WRITE @IOF
+2 ; SD*5.3*645 - replaced 'Date Desired' with 'CID/PD' and adjusted format
+3 ;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!
+4 WRITE !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",!
END KILL X1,X2,CT1,CT2,DATE,I,INS,OPEN,FORM
+1 KILL ^TMP("SDWLRPT1",$JOB)
QUIT
+2 ;
