SDWLRPT1.m

SDWLRPT1 ;;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1;06/12/2002 ; 29 Aug 2002  2:54 PM

 ;;5.3;scheduling;**263,399,394,1015**;AUG 13 1993;Build 21

 ;

 ;

 ;******************************************************************

 ;                             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

 .....W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired 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

 W !,?23,"Date Desired 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

SDWLRPT1  ;;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1;06/12/2002 ; 29 Aug 2002  2:54 PM

 +1       ;;5.3;scheduling;**263,399,394,1015**;AUG 13 1993;Build 21

 +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                                               WRITE ?35,SDWLSSN

                                                   IF SDWLAPTD'=""

                                                       WRITE ?50,"Desired Date: ",SDWLAPTD

 +19                                               WRITE !,"Primary Eligibility: ",$PIECE(SDWLELIG,U,2)

 +20      ;PATCH SD*5.3*394 See Note.

 +21                                               NEW SDWLSCP

 +22                                               WRITE !,"Service Connected Priority: "

                                                   SET SDWLSCP=$$GET1^DIQ(409.3,SDWLE_",",15,"I")

                                                   WRITE $SELECT(SDWLSCP=1:"YES",1:"NO")

 +23                                               WRITE !,"Comments: ",SDWLCOM,!

 +24                                               IF SDWLRBY

                                                       WRITE !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY)

 +25                                               IF SDWLRPV

                                                       WRITE ?35,"Requesting Provider: "

                                                       SET X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV)

                                                       WRITE X

 +26                                               WRITE !,"Telephone (Home): ",$PIECE(SDWLPH,U,1)

                                                   IF $PIECE(SDWLPH,U,2)

                                                       WRITE !,?10,"(Work): ",$PIECE(SDWLPH,U,2)

 +27                                               IF $DATA(^SDWL(409.3,SDWLE,"DIS"))

                                                       Begin DoDot:6

 +28                                                       SET SDWLDISX=$GET(^SDWL(409.3,SDWLE,"DIS"))

                                                           SET SDWLDIS=$PIECE(SDWLDISX,U,3)

                                                           SET SDWLDDUZ=$PIECE(SDWLDISX,U,2)

 +29                                                       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

 +30                                               IF $DATA(SDWLDISX)

                                                       WRITE !,"Disposition: ",$PIECE(SDWLDISX,U,3)," (",SDWLDIDT,")"

                                                       KILL SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT

 +31                                               WRITE !,"*****"

 +32                                               IF $DATA(SDWLSPT)

                                                       IF $Y>IOSL

                                                           SET DIR(0)="E"

                                                           DO ^DIR

                                                           IF X["^"

                                                               SET DUOUT=1

                                                               QUIT 

 +33                                               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 

 +34       WRITE !!,"** End of Report **"

 +35       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        WRITE !,?23,"Date Desired Range: ",SDWLBDT

 +8        IF SDWLEDT'=""

               WRITE " to ",SDWLEDT

 +9        SET X=$PIECE(SDWLCT2,U,2)

 +10       WRITE !?26,"Report Category: ",$SELECT($PIECE(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY")

           IF X="ALL"

               WRITE " ALL"

 +11       SET SDWLF=$PIECE(SDWLCT1,U,1)

 +12       IF X'="ALL"

               Begin DoDot:1

 +13               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

 +14       SET X=$GET(SDWLOPEN)

           WRITE !,?35,"Status: ",$SELECT(SDWLOPEN="O":"Open",1:"All")

 +15       SET X=$GET(SDWLFORM)

           WRITE !,?28,"Output Format: ",$SELECT(SDWLFORM="S":"Summary",1:"Detailed")

 +16       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