SDWLRPT1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1 ;1/5/16 3:39pm
;;5.3;scheduling;**263,399,394,645**;AUG 13 1993;Build 7
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
;
;
EN D INIT
I $$S^%ZTLOAD G END
D SORT
I $$S^%ZTLOAD G END
D PRINT
I $$S^%ZTLOAD G END
K ^TMP("SDWLRPT1",$J),^TMP("SDWLRQ1",$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)
INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
Q
SORT ;Sort Records
S SDWLDA=0,SDWLCNT=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
.;-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 SDWLTYP=$P(SDWLCT1,U,1),SDWLTYPE=$S(SDWLTYP="C":$P(SDWLX,U,9),1:$P(SDWLX,U,8)) I SDWLTYPE="" S SDWLERR=7 Q
.I SDWLCT2'="ALL" D
..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
.I SDWLTYP="" S SDWLERR=4 Q
.I $P(SDWLX,U,3)=""!($P(SDWLX,U,16)="") S SDWLERR=5 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 SDWLF=$P(SDWLCT1,U,2)
..S SDWLIENS=$P(SDWLX,U,3)_",",X=$$GET1^DIQ(4,SDWLIENS,".01")
..S SDWLSIEN=SDWLTYPE_",",Y=$$GET1^DIQ(SDWLF,SDWLSIEN,".01")
..S ^TMP("SDWLRPT1",$J,X,Y,SDWLSCC,+$P(SDWLX,U,16),SDWLDA)=""
..S SDWLCNT=SDWLCNT+1,^TMP("SDWLRPT1",$J,$P(^DIC(4,+$P(SDWLX,U,3),0),U,1))=SDWLCNT
Q
PRINT ;Print Report
N DFN
D HD S SDWLCNT=0 I '$D(^TMP("SDWLRPT1",$J)) W !!,?80-$L("*** No Patient Records to Report ***")\2,"*** No Patient Records to Report ***" Q
S SDWLA="" F S SDWLA=$O(^TMP("SDWLRPT1",$J,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA="" D Q:$D(DUOUT)
.D LINE W !!,"Institution: " S X=SDWLA W X I '$G(^TMP("SDWLRPT1",$J,SDWLA)) W !!,"*** No Patient Records to Report ***"
.S SDWLB="" F S SDWLB=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB)) Q:SDWLB="" D Q:$D(DUOUT)
..W !!,"Clinic/Service: " S X=SDWLB W X,! Q:$D(DUOUT)
..S SDWLC="" F S SDWLC=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC)) Q:SDWLC="" D Q:$D(DUOUT)
...S SDWLD="" F S SDWLD=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD)) Q:SDWLD="" D Q:$D(DUOUT)
....S SDWLE="" F S SDWLE=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD,SDWLE)) Q:SDWLE="" D Q:$D(DUOUT)
.....S SDWLDFN=$P($G(^SDWL(409.3,SDWLE,0)),U,1),DFN=SDWLDFN D DEM^VADPT,ELIG^VADPT,ADD^VADPT
.....S SDWLNAM=VADM(1),SDWLELIG=VAEL(1) I SDWLELIG="" S SDWLELIG=0
.....I SDWLELIG=0 S SDWLELIG="No Eligibility Status found"
.....S SDWLDEAD=1
.....S SDWLSSN=VA("BID"),SDWLAPTD=$P(^SDWL(409.3,SDWLE,0),U,16),SDWLCOM=$P(^SDWL(409.3,SDWLE,0),U,18)
.....S SDWLRBY=$P(^SDWL(409.3,SDWLE,0),U,12),SDWLRPV=$P(^SDWL(409.3,SDWLE,0),U,13)
.....S SDWLPH=$G(VAPA(8)) I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y
.....W !!,SDWLNAM
.....; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user
.....;W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired Date: ",SDWLAPTD
.....W ?35,SDWLSSN I SDWLAPTD'="" W ?48,"CID/Preferred Date: ",SDWLAPTD
.....W !,"Primary Eligibility: ",$P(SDWLELIG,U,2)
.....;PATCH SD*5.3*394 See Note.
.....N SDWLSCP
.....W !,"Service Connected Priority: " S SDWLSCP=$$GET1^DIQ(409.3,SDWLE_",",15,"I") W $S(SDWLSCP=1:"YES",1:"NO")
.....W !,"Comments: ",SDWLCOM,!
.....I SDWLRBY W !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY)
.....I SDWLRPV W ?35,"Requesting Provider: " S X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV) W X
.....W !,"Telephone (Home): ",$P(SDWLPH,U,1) I $P(SDWLPH,U,2) W !,?10,"(Work): ",$P(SDWLPH,U,2)
.....I $D(^SDWL(409.3,SDWLE,"DIS")) D
......S SDWLDISX=$G(^SDWL(409.3,SDWLE,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2)
......S SDWLDDT=$P(^SDWL(409.3,SDWLE,"DIS"),U,1),SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3)
.....I $D(SDWLDISX) W !,"Disposition: ",$P(SDWLDISX,U,3)," (",SDWLDIDT,")" K SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT
.....W !,"*****"
.....I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR I X["^" S DUOUT=1 Q
.....I '$D(SDWLSPT),'$D(DUOUT),$Y>(IOSL-5) D HD
W !!,"** End of Report **"
Q
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', adjusted format
;W !,?23,"Date Desired Range: ",SDWLBDT
W !,?17,"CID/Preferred Date Range: ",SDWLBDT
I SDWLEDT'="" W " to ",SDWLEDT
S X=$P(SDWLCT2,U,2)
W !?26,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL"
S SDWLF=$P(SDWLCT1,U,1)
I X'="ALL" D
.F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$S(SDWLF="C":$P(^SC(X,0),U,1),1:$P(^DIC(40.7,X,0),U,1))
S X=$G(SDWLOPEN) W !,?35,"Status: ",$S(SDWLOPEN="O":"Open",1:"All")
S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
Q
END K SDWL,SDWLA,SDWLAPTD,SDWLB,SDWLBD,SDWLBDT,SDWLC,SDWLCAT,SDWLCNT,SDWLCOM,SDWLCT1,SDWLCT2,SDWLCTX,SDWLD
K SDLWDA,SDLWDEAD,SDWLDFN,SDWLE,SDWLEDT,SDWLELIG,SDWLERR,SDWLF,SDWLFD,SDWLI,SDWLIN,SDWLINS,SDWLINST
K SDWLNAM,SDWLPD,SDWLPG,SDWLPH,SDWLPROM,SDWLRBY,SDWLPRV,SDWLSCC,SDWLSPT,SDWLSSN,SDWLTAG,SDLTK,SDWLTXP
K SDWLTYP,SDWLTYPE,SDWLX,VDAM,VAPA,SDWLIENS,CT1,CT2,DATE,I,INS,OPEN,FORM,SDWLSIEN
D EN^SDWLKIL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRPT1 6765 printed Oct 16, 2024@19:03:42 Page 2
SDWLRPT1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1 ;1/5/16 3:39pm
+1 ;;5.3;scheduling;**263,399,394,645**;AUG 13 1993;Build 7
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ;
+12 ;
EN DO INIT
+1 IF $$S^%ZTLOAD
GOTO END
+2 DO SORT
+3 IF $$S^%ZTLOAD
GOTO END
+4 DO PRINT
+5 IF $$S^%ZTLOAD
GOTO END
+6 KILL ^TMP("SDWLRPT1",$JOB),^TMP("SDWLRQ1",$JOB)
+7 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)
INIT1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET SDWLDTP=$PIECE(Y,":",1,2)
+1 QUIT
SORT ;Sort Records
+1 SET SDWLDA=0
SET SDWLCNT=0
FOR
SET SDWLDA=$ORDER(^SDWL(409.3,SDWLDA))
if SDWLDA<1
QUIT
Begin DoDot:1
+2 SET SDWLX=$GET(^SDWL(409.3,SDWLDA,0))
SET SDWLERR=0
SET SDWLDFN=+SDWLX
+3 ;-Check for Institution Sort
+4 IF SDWLINS'="ALL"
Begin DoDot:2
+5 IF '$DATA(SDWLIN(+$PIECE(SDWLX,U,3)))
SET SDWLERR=1
QUIT
End DoDot:2
+6 ;-Check for Date Range Compliance
+7 IF $PIECE(SDWLX,U,16)<SDWLBD!($PIECE(SDWLX,U,16)>SDWLED)
SET SDWLERR=2
QUIT
+8 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
+9 IF SDWLCT2'="ALL"
Begin DoDot:2
+10 IF '$DATA(SDWLCT2(SDWLTYPE))
SET SDWLERR=3
End DoDot:2
+11 IF SDWLTYP=""
SET SDWLERR=4
QUIT
+12 IF $PIECE(SDWLX,U,3)=""!($PIECE(SDWLX,U,16)="")
SET SDWLERR=5
QUIT
+13 IF SDWLOPEN'["C"
IF $PIECE(SDWLX,U,17)'[SDWLOPEN
SET SDWLERR=6
QUIT
+14 if SDWLERR
QUIT
Begin DoDot:2
+15 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
+16 SET SDWLF=$PIECE(SDWLCT1,U,2)
+17 SET SDWLIENS=$PIECE(SDWLX,U,3)_","
SET X=$$GET1^DIQ(4,SDWLIENS,".01")
+18 SET SDWLSIEN=SDWLTYPE_","
SET Y=$$GET1^DIQ(SDWLF,SDWLSIEN,".01")
+19 SET ^TMP("SDWLRPT1",$JOB,X,Y,SDWLSCC,+$PIECE(SDWLX,U,16),SDWLDA)=""
+20 SET SDWLCNT=SDWLCNT+1
SET ^TMP("SDWLRPT1",$JOB,$PIECE(^DIC(4,+$PIECE(SDWLX,U,3),0),U,1))=SDWLCNT
End DoDot:2
End DoDot:1
+21 QUIT
PRINT ;Print Report
+1 NEW DFN
+2 DO HD
SET SDWLCNT=0
IF '$DATA(^TMP("SDWLRPT1",$JOB))
WRITE !!,?80-$LENGTH("*** No Patient Records to Report ***")\2,"*** No Patient Records to Report ***"
QUIT
+3 SET SDWLA=""
FOR
SET SDWLA=$ORDER(^TMP("SDWLRPT1",$JOB,SDWLA))
if $$S^%ZTLOAD
GOTO END
if SDWLA=""
QUIT
Begin DoDot:1
+4 DO LINE
WRITE !!,"Institution: "
SET X=SDWLA
WRITE X
IF '$GET(^TMP("SDWLRPT1",$JOB,SDWLA))
WRITE !!,"*** No Patient Records to Report ***"
+5 SET SDWLB=""
FOR
SET SDWLB=$ORDER(^TMP("SDWLRPT1",$JOB,SDWLA,SDWLB))
if SDWLB=""
QUIT
Begin DoDot:2
+6 WRITE !!,"Clinic/Service: "
SET X=SDWLB
WRITE X,!
if $DATA(DUOUT)
QUIT
+7 SET SDWLC=""
FOR
SET SDWLC=$ORDER(^TMP("SDWLRPT1",$JOB,SDWLA,SDWLB,SDWLC))
if SDWLC=""
QUIT
Begin DoDot:3
+8 SET SDWLD=""
FOR
SET SDWLD=$ORDER(^TMP("SDWLRPT1",$JOB,SDWLA,SDWLB,SDWLC,SDWLD))
if SDWLD=""
QUIT
Begin DoDot:4
+9 SET SDWLE=""
FOR
SET SDWLE=$ORDER(^TMP("SDWLRPT1",$JOB,SDWLA,SDWLB,SDWLC,SDWLD,SDWLE))
if SDWLE=""
QUIT
Begin DoDot:5
+10 SET SDWLDFN=$PIECE($GET(^SDWL(409.3,SDWLE,0)),U,1)
SET DFN=SDWLDFN
DO DEM^VADPT
DO ELIG^VADPT
DO ADD^VADPT
+11 SET SDWLNAM=VADM(1)
SET SDWLELIG=VAEL(1)
IF SDWLELIG=""
SET SDWLELIG=0
+12 IF SDWLELIG=0
SET SDWLELIG="No Eligibility Status found"
+13 SET SDWLDEAD=1
+14 SET SDWLSSN=VA("BID")
SET SDWLAPTD=$PIECE(^SDWL(409.3,SDWLE,0),U,16)
SET SDWLCOM=$PIECE(^SDWL(409.3,SDWLE,0),U,18)
+15 SET SDWLRBY=$PIECE(^SDWL(409.3,SDWLE,0),U,12)
SET SDWLRPV=$PIECE(^SDWL(409.3,SDWLE,0),U,13)
+16 SET SDWLPH=$GET(VAPA(8))
IF SDWLAPTD'=""
SET Y=SDWLAPTD
DO DD^%DT
SET SDWLAPTD=Y
+17 WRITE !!,SDWLNAM
+18 ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user
+19 ;W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired Date: ",SDWLAPTD
+20 WRITE ?35,SDWLSSN
IF SDWLAPTD'=""
WRITE ?48,"CID/Preferred Date: ",SDWLAPTD
+21 WRITE !,"Primary Eligibility: ",$PIECE(SDWLELIG,U,2)
+22 ;PATCH SD*5.3*394 See Note.
+23 NEW SDWLSCP
+24 WRITE !,"Service Connected Priority: "
SET SDWLSCP=$$GET1^DIQ(409.3,SDWLE_",",15,"I")
WRITE $SELECT(SDWLSCP=1:"YES",1:"NO")
+25 WRITE !,"Comments: ",SDWLCOM,!
+26 IF SDWLRBY
WRITE !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY)
+27 IF SDWLRPV
WRITE ?35,"Requesting Provider: "
SET X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV)
WRITE X
+28 WRITE !,"Telephone (Home): ",$PIECE(SDWLPH,U,1)
IF $PIECE(SDWLPH,U,2)
WRITE !,?10,"(Work): ",$PIECE(SDWLPH,U,2)
+29 IF $DATA(^SDWL(409.3,SDWLE,"DIS"))
Begin DoDot:6
+30 SET SDWLDISX=$GET(^SDWL(409.3,SDWLE,"DIS"))
SET SDWLDIS=$PIECE(SDWLDISX,U,3)
SET SDWLDDUZ=$PIECE(SDWLDISX,U,2)
+31 SET SDWLDDT=$PIECE(^SDWL(409.3,SDWLE,"DIS"),U,1)
SET SDWLDIDT=$EXTRACT(SDWLDDT,4,5)_"/"_$EXTRACT(SDWLDDT,6,7)_"/"_$EXTRACT(SDWLDDT,2,3)
End DoDot:6
+32 IF $DATA(SDWLDISX)
WRITE !,"Disposition: ",$PIECE(SDWLDISX,U,3)," (",SDWLDIDT,")"
KILL SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT
+33 WRITE !,"*****"
+34 IF $DATA(SDWLSPT)
IF $Y>IOSL
SET DIR(0)="E"
DO ^DIR
IF X["^"
SET DUOUT=1
QUIT
+35 IF '$DATA(SDWLSPT)
IF '$DATA(DUOUT)
IF $Y>(IOSL-5)
DO HD
End DoDot:5
if $DATA(DUOUT)
QUIT
End DoDot:4
if $DATA(DUOUT)
QUIT
End DoDot:3
if $DATA(DUOUT)
QUIT
End DoDot:2
if $DATA(DUOUT)
QUIT
End DoDot:1
if $DATA(DUOUT)
QUIT
+36 WRITE !!,"** End of Report **"
+37 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', adjusted format
+8 ;W !,?23,"Date Desired Range: ",SDWLBDT
+9 WRITE !,?17,"CID/Preferred Date Range: ",SDWLBDT
+10 IF SDWLEDT'=""
WRITE " to ",SDWLEDT
+11 SET X=$PIECE(SDWLCT2,U,2)
+12 WRITE !?26,"Report Category: ",$SELECT($PIECE(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY")
IF X="ALL"
WRITE " ALL"
+13 SET SDWLF=$PIECE(SDWLCT1,U,1)
+14 IF X'="ALL"
Begin DoDot:1
+15 FOR I=1:1
SET X=$PIECE($PIECE(SDWLCT2,";",I),"^",2)
if X=""
QUIT
WRITE !,?45,$SELECT(SDWLF="C":$PIECE(^SC(X,0),U,1),1:$PIECE(^DIC(40.7,X,0),U,1))
End DoDot:1
+16 SET X=$GET(SDWLOPEN)
WRITE !,?35,"Status: ",$SELECT(SDWLOPEN="O":"Open",1:"All")
+17 SET X=$GET(SDWLFORM)
WRITE !,?28,"Output Format: ",$SELECT(SDWLFORM="S":"Summary",1:"Detailed")
+18 QUIT
END KILL SDWL,SDWLA,SDWLAPTD,SDWLB,SDWLBD,SDWLBDT,SDWLC,SDWLCAT,SDWLCNT,SDWLCOM,SDWLCT1,SDWLCT2,SDWLCTX,SDWLD
+1 KILL SDLWDA,SDLWDEAD,SDWLDFN,SDWLE,SDWLEDT,SDWLELIG,SDWLERR,SDWLF,SDWLFD,SDWLI,SDWLIN,SDWLINS,SDWLINST
+2 KILL SDWLNAM,SDWLPD,SDWLPG,SDWLPH,SDWLPROM,SDWLRBY,SDWLPRV,SDWLSCC,SDWLSPT,SDWLSSN,SDWLTAG,SDLTK,SDWLTXP
+3 KILL SDWLTYP,SDWLTYPE,SDWLX,VDAM,VAPA,SDWLIENS,CT1,CT2,DATE,I,INS,OPEN,FORM,SDWLSIEN
+4 DO EN^SDWLKIL
+5 QUIT
