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
Q
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
Q
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
Q
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)=""
Q
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",%)=""
Q
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)=""
Q
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
Q
HD W:$D(IOF) @IOF W !,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
Q
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRAD 4082 printed Nov 22, 2024@18:12:57 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
