Routine: SDWLRAD

SDWLRAD ;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT ;1/5/16 4:21pm

 ;;5.3;scheduling;**263,645**;AUG 13 1993;Build 7

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

 ;                             CHANGE LOG

 ;   DATE                        PATCH                   DESCRIPTION

 ;   ----                        -----                   -----------

EN ;Header

 D HD

 S SDWLINST="",SDWLE=0 K ^TMP("SDWLRAD",$J),DIC,DIR,DR,DIE

 D INS

 D DATE G INS:E

 D CAT G DATE:E

 D PRI G CAT:E

 D OPEN G PRI:E

 D FORM G OPEN:E

 D DIS

 I E D QUE

INS ;Get Institution

 W !! S DIC(0)="QEMA",DIC("A")="Select Institution ALL // ",DIC=4,DIC("S")="I $D(^SDWL(409.32,""C"",+Y))" D ^DIC I Y<0,'SDWLE S Y="ALL"

 G INS:Y<0,END:$D(DUOUT)

 I Y="All"!(Y="")!(Y="all")!(Y="ALL") D

 .S SDWLINST="ALL",SDWLE=1 S ^TMP("SDWLRAD",$J,"INS","ALL")=""

 I 'SDWLE S SDWLERR=1,^TMP("SDWLRAD",$J,"INS",Y)="" G INS

DATE ;Date range selection

 S SDWLERR=0 W ! S %DT="AE",%DT("A")="Beginning Date: " D ^%DT G E1:Y<1 S SDWLBDT=Y

 S %DT(0)=SDWLBDT,%DT("A")="Ending Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")

 I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE

 S ^TMP("SDWLRAD",$J,"DATE",SDWLBDT_"^"_SDWLEDT)="" Q

E1 S %=1 W !,"Print Report for ALL dates? " D YN^DICN S ^TMP("SDWLRAD",$J,"DATE","ALL")=""

 I %=2 S SDWLERR=1 Q

 I %=-1 G END

CAT ;Report category selection

 W !!,"    *** Report Category Selection ***" S SDWLERR=0

 S SDWLCAT=0,DIR(0)="S0^1:Clinic;2:Select Service/Specialty",DIR("L",1)="C. Clinic",DIR("L")="S. Service/Specialty"

 D ^DIR

 I X="^" S SDWLERR=1 Q

 I X="" S SDWLERR=1 Q

 I X'?1"C".E,X'?1"S".E W " Invalid Selection." G CAT

 W !!,"Select Category for Report Output",!

 S SDWLX=$S(X="C":"Clinic: ALL/ ",X="S":"Service/Specialty: ALL/ ")

 S SDWLF=$S(X="C":409.32,X="S":409.31)

CT1 W !! S DIC(0)="QEMA",DIC("A")=SDWLX,DIC=SDWLF D ^DIC I 'SDWLCAT,Y<1 S ^TMP("SDWLRAD",$J,"CAT","ALL")="" G CT2

 I SDWLCAT,Y<0 S SDWLERR=1 Q

 I 'SDWLCAT,Y<0 S SDWLERR=1 Q

 S SDWLCAT=1

 S ^TMP("SDWLRAD",$J,"CAT",Y)="" G CT1

CT2 Q

PRI ;Priority

 K DIR,DIC S SDWLERR=0

 S DIR(0)="S0^1:F:Future;I:Immediate",DIR("L",2)="     F. Future",DIR("L")="     I. Immediate",DIR("L",1)="Select One of the Following: "

 D ^DIR

 I X="" S SDWLERR=1 Q

 I X="^" S SDWLERR=1 Q

 S ^TMP("SDWLRAD",$J,"PRI",X)=""

OPEN ;OPEN Wait List Entries

 S %=1 W !!,"Do you want to 'OPEN' Wait List Entries " D YN^DICN

 I %=-1 S SDWLERR=1

 S ^TMP("SDWLRAD",$J,"OPEN",%)=""

FORM ;Report Format

 S SDWLERR=0,DIR(0)="SO^1:D:Detailed;S:Summary",DIR("L",2)="D. Detailed",DIR("L")="S. Summary",DIR("L",1)="Select One of the Following: "

 D ^DIR

 I X="",X="^" S SDWLERR=1

 S ^TMP("SDWLRAD",$J,"FORM",X)=""

DIS ;Display Parameters

 S SDWLERR=0 W !!,?80-$L("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters",!

 F SDWLI="CAT","DATE","INS","FORM","OPEN","PRI" D

 .S X="SDWL"_SDWLI,@X=$O(^TMP("SDWLRAD",$J,SDWLI,""))

 I SDWLINS'="ALL" D

 .I 'E W !,"Institution: ALL INSTITUTIONS"

 ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'

 ;W !,"Date Desired Range: " S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBD=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLED=Y W " ",SDWLBD," to ",SDWLED

 W !,"CID/Preferred Date Range: " S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBD=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLED=Y W " ",SDWLBD," to ",SDWLED

 W !,"Report Category: ",$S(SDWLCAT="C":" Clinic",1:" Service/Specialty")

 W !,"Priority: ",$S(SDWLPRI="I":" Immediate",1:" Future")

 W !,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary")

 I SDWLOPEN W !,"Printing 'OPEN' Entries Only."

 S %=1 W !!,"Are these Parameters Correct " D YN^DICN I %=2 S SDWLERR=1 W !,"  This Report will NOT be queued to print."

 I %-1 W !,"   This Report will NOT be queued and returning." S SDWLERR=2

QUE ;Queue Report

HD W:$D(IOF) @IOF W !,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"

END Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRAD   4082     printed  Mar 13, 2025@22:08:10                                                                                                                                                                                                     Page 2

SDWLRAD   ;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT ;1/5/16 4:21pm

 +1       ;;5.3;scheduling;**263,645**;AUG 13 1993;Build 7

 +2       ;

 +3       ;

 +4       ;******************************************************************

 +5       ;                             CHANGE LOG

 +6       ;

 +7       ;   DATE                        PATCH                   DESCRIPTION

 +8       ;   ----                        -----                   -----------

 +9       ;

 +10      ;

 +11      ;

 +12      ;

EN        ;Header

 +1        DO HD

 +2        SET SDWLINST=""

           SET SDWLE=0

           KILL ^TMP("SDWLRAD",$JOB),DIC,DIR,DR,DIE

 +3        DO INS

 +4        DO DATE

           if E

               GOTO INS

 +5        DO CAT

           if E

               GOTO DATE

 +6        DO PRI

           if E

               GOTO CAT

 +7        DO OPEN

           if E

               GOTO PRI

 +8        DO FORM

           if E

               GOTO OPEN

 +9        DO DIS

 +10       IF E

               DO QUE

 +11       QUIT

INS       ;Get Institution

 +1        WRITE !!

           SET DIC(0)="QEMA"

           SET DIC("A")="Select Institution ALL // "

           SET DIC=4

           SET DIC("S")="I $D(^SDWL(409.32,""C"",+Y))"

           DO ^DIC

           IF Y<0

               IF 'SDWLE

                   SET Y="ALL"

 +2        if Y<0

               GOTO INS

           if $DATA(DUOUT)

               GOTO END

 +3        IF Y="All"!(Y="")!(Y="all")!(Y="ALL")

               Begin DoDot:1

 +4                SET SDWLINST="ALL"

                   SET SDWLE=1

                   SET ^TMP("SDWLRAD",$JOB,"INS","ALL")=""

               End DoDot:1

 +5        IF 'SDWLE

               SET SDWLERR=1

               SET ^TMP("SDWLRAD",$JOB,"INS",Y)=""

               GOTO INS

 +6        QUIT

DATE      ;Date range selection

 +1        SET SDWLERR=0

           WRITE !

           SET %DT="AE"

           SET %DT("A")="Beginning Date: "

           DO ^%DT

           if Y<1

               GOTO E1

           SET SDWLBDT=Y

 +2        SET %DT(0)=SDWLBDT

           SET %DT("A")="Ending Date: "

           DO ^%DT

           if Y<1

               GOTO DATE

           SET SDWLEDT=Y

           KILL %DT(0),%DT("A")

 +3        IF SDWLEDT<SDWLBDT

               WRITE !,"Beginning Date must be greater than Ending Date."

               GOTO DATE

 +4        SET ^TMP("SDWLRAD",$JOB,"DATE",SDWLBDT_"^"_SDWLEDT)=""

           QUIT

E1         SET %=1

           WRITE !,"Print Report for ALL dates? "

           DO YN^DICN

           SET ^TMP("SDWLRAD",$JOB,"DATE","ALL")=""

 +1        IF %=2

               SET SDWLERR=1

               QUIT

 +2        IF %=-1

               GOTO END

 +3        QUIT

CAT       ;Report category selection

 +1        WRITE !!,"    *** Report Category Selection ***"

           SET SDWLERR=0

 +2        SET SDWLCAT=0

           SET DIR(0)="S0^1:Clinic;2:Select Service/Specialty"

           SET DIR("L",1)="C. Clinic"

           SET DIR("L")="S. Service/Specialty"

 +3        DO ^DIR

 +4        IF X="^"

               SET SDWLERR=1

               QUIT

 +5        IF X=""

               SET SDWLERR=1

               QUIT

 +6        IF X'?1"C".E

               IF X'?1"S".E

                   WRITE " Invalid Selection."

                   GOTO CAT

 +7        WRITE !!,"Select Category for Report Output",!

 +8        SET SDWLX=$SELECT(X="C":"Clinic: ALL/ ",X="S":"Service/Specialty: ALL/ ")

 +9        SET SDWLF=$SELECT(X="C":409.32,X="S":409.31)

CT1        WRITE !!

           SET DIC(0)="QEMA"

           SET DIC("A")=SDWLX

           SET DIC=SDWLF

           DO ^DIC

           IF 'SDWLCAT

               IF Y<1

                   SET ^TMP("SDWLRAD",$JOB,"CAT","ALL")=""

                   GOTO CT2

 +1        IF SDWLCAT

               IF Y<0

                   SET SDWLERR=1

                   QUIT

 +2        IF 'SDWLCAT

               IF Y<0

                   SET SDWLERR=1

                   QUIT

 +3        SET SDWLCAT=1

 +4        SET ^TMP("SDWLRAD",$JOB,"CAT",Y)=""

           GOTO CT1

CT2        QUIT

PRI       ;Priority

 +1        KILL DIR,DIC

           SET SDWLERR=0

 +2        SET DIR(0)="S0^1:F:Future;I:Immediate"

           SET DIR("L",2)="     F. Future"

           SET DIR("L")="     I. Immediate"

           SET DIR("L",1)="Select One of the Following: "

 +3        DO ^DIR

 +4        IF X=""

               SET SDWLERR=1

               QUIT

 +5        IF X="^"

               SET SDWLERR=1

               QUIT

 +6        SET ^TMP("SDWLRAD",$JOB,"PRI",X)=""

 +7        QUIT

OPEN      ;OPEN Wait List Entries

 +1        SET %=1

           WRITE !!,"Do you want to 'OPEN' Wait List Entries "

           DO YN^DICN

 +2        IF %=-1

               SET SDWLERR=1

 +3        SET ^TMP("SDWLRAD",$JOB,"OPEN",%)=""

 +4        QUIT

FORM      ;Report Format

 +1        SET SDWLERR=0

           SET DIR(0)="SO^1:D:Detailed;S:Summary"

           SET DIR("L",2)="D. Detailed"

           SET DIR("L")="S. Summary"

           SET DIR("L",1)="Select One of the Following: "

 +2        DO ^DIR

 +3        IF X=""

               IF X="^"

                   SET SDWLERR=1

 +4        SET ^TMP("SDWLRAD",$JOB,"FORM",X)=""

 +5        QUIT

DIS       ;Display Parameters

 +1        SET SDWLERR=0

           WRITE !!,?80-$LENGTH("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters",!

 +2        FOR SDWLI="CAT","DATE","INS","FORM","OPEN","PRI"

               Begin DoDot:1

 +3                SET X="SDWL"_SDWLI

                   SET @X=$ORDER(^TMP("SDWLRAD",$JOB,SDWLI,""))

               End DoDot:1

 +4        IF SDWLINS'="ALL"

               Begin DoDot:1

 +5                IF 'E

                       WRITE !,"Institution: ALL INSTITUTIONS"

               End DoDot:1

 +6       ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'

 +7       ;W !,"Date Desired Range: " S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBD=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLED=Y W " ",SDWLBD," to ",SDWLED

 +8        WRITE !,"CID/Preferred Date Range: "

           SET Y=$PIECE(SDWLDATE,U,1)

           DO DD^%DT

           SET SDWLBD=Y

           SET Y=$PIECE(SDWLDATE,U,2)

           DO DD^%DT

           SET SDWLED=Y

           WRITE " ",SDWLBD," to ",SDWLED

 +9        WRITE !,"Report Category: ",$SELECT(SDWLCAT="C":" Clinic",1:" Service/Specialty")

 +10       WRITE !,"Priority: ",$SELECT(SDWLPRI="I":" Immediate",1:" Future")

 +11       WRITE !,"Output Format: ",$SELECT(SDWLFORM="D":" Detailed",1:" Summary")

 +12       IF SDWLOPEN

               WRITE !,"Printing 'OPEN' Entries Only."

 +13       SET %=1

           WRITE !!,"Are these Parameters Correct "

           DO YN^DICN

           IF %=2

               SET SDWLERR=1

               WRITE !,"  This Report will NOT be queued to print."

 +14       IF %-1

               WRITE !,"   This Report will NOT be queued and returning."

               SET SDWLERR=2

QUE       ;Queue Report

 +1        QUIT

HD         if $DATA(IOF)

               WRITE @IOF

           WRITE !,?80-$LENGTH("Appointment Wait List Report")\2,"Appointment Wait List Report"

 +1        QUIT

END        QUIT

SDWLRAD.m