SDWLRQ1 ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT;06/12/2002 ; 20 Aug 2002 2:10 PM
;;5.3;scheduling;**263,399,412,425,448,1015**;AUG 13 1993;Build 21
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
;
;
EN ;Header
N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
D HD
S SDWLINST="",SDWLERR=0 K ^TMP("SDWLRQ1",$J),DIC,DIR,DR,DIE
1 D INS G END:$D(DUOUT)
2 D CAT G 1:SDWLERR,2:$D(DUOUT)
3 D DATE G 2:SDWLERR,END:$D(DUOUT)
4 D OPEN G 3:SDWLERR,3:$D(DUOUT)
5 D FORM G 4:SDWLERR,4:$D(DUOUT)
6 D DIS G EN:SDWLERR=1,END:SDWLERR=2
D QUE
Q
INS ;Get Institution
N SDWLINST S SDWLINST=""
S SDWLERR=0,SDWLPROM="Select Institution ALL // "
IN W ! S DIC(0)="QEMA",DIC("A")=SDWLPROM,DIC=4,DIC("S")="I $D(^SDWL(409.32,""C"",+Y))!($D(^SDWL(409.31,""E"",+Y)))!($D(^SCTM(404.51,""AINST"",+Y)))" D ^DIC I Y<0,'SDWLERR Q:$D(DUOUT) S Y="ALL"
G IN2:Y<0 Q:$D(DUOUT)
I Y<0 S SDWLINST=$S(Y="ALL":"ALL",Y="":"ALL",Y="all":"ALL",Y="All":"ALL",Y["A":"ALL",Y["a":"ALL")
I Y="All"!(Y="")!(Y="all")!(Y="ALL") S SDWLINST="ALL",^TMP("SDWLRQ1",$J,"INS")="ALL" G IN3
S SDWLINST=SDWLINST_Y_";",SDWLPROM="Another Institution: ",SDWLERR=1 G IN
IN2 S ^TMP("SDWLRQ1",$J,"INS")=SDWLINST
IN3 Q
CAT ;Report category selection
K DIR,DIE,DR,DIC
W !!," *** Report Category Selection ***" S SDWLERR=0
S SDWLERR=0,SDWLCAT="",DIR(0)="SO^1:Clinic;2:Select Service/Specialty",DIR("L",1)=" 1. Clinic",DIR("L")=" 2. Service/Specialty"
D ^DIR
I X="^" S SDWLERR=1 W *7 Q
I X="" S SDWLERR=1 W *7 Q
S X=$S(X["C":"C",X["c":"C",X["S":"S",X["s":"S",X=1:"C",X=2:"S",1:"")
I X="" W *7," 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,X["c":409.32,X["s":409.31)
S SDWLFD=$S(X="C":8,1:7)
S SDWLCTX=X
K DIR,DIC,DR
S ^TMP("SDWLRQ1",$J,"CT1")=SDWLCTX_"^"_SDWLF_"^"_SDWLFD,DIC("A")=SDWLX,SDWLE=0
CT1 W ! S DIC(0)="QEMNZA",DIC=SDWLF D ^DIC I 'SDWLE,Y<1 S ^TMP("SDWLRQ1",$J,"CT2")="ALL" G CT3
I Y<0,'$D(^TMP("SDWLRQ1",$J,"CT1")) W !,"This Entry is Required." G CAT
G CT2:Y<0
S SDWLCAT=SDWLCAT_Y_";",DIC("A")="Another "_$P(SDWLX,":",1)_": ",SDWLE=1 G CT1
CT2 G CT1:'$D(SDWLCAT) S ^TMP("SDWLRQ1",$J,"CT2")=SDWLCAT
CT3 Q
DATE ;Date range selection
K X,Y,%DT
S %=1 W !!,"Print Report for ALL dates? " D YN^DICN
I %=1 S ^TMP("SDWLRQ1",$J,"DATE")="ALL" G E1
Q:%=0
Q:%=-1
S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Desired Appointment Date: " D ^%DT
I X["^" S SDWLERR=1 Q
G E1:Y<0 S SDWLBDT=Y
Q:$D(DUOUT)
S %DT(0)=SDWLBDT,%DT("A")="End with Desired Appointment Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
G DATE:$D(DUOUT)
I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
S ^TMP("SDWLRQ1",$J,"DATE")=SDWLBDT_"^"_SDWLEDT Q
E1 Q
OPEN ;OPEN Wait List Entries
S %=1 W !!,"Do you want only 'OPEN' Wait List Entries " D YN^DICN
I %=0 W " Response must be 'YES' or 'NO'." G OPEN
I %=-1 S SDWLERR=1 W *7,"?? "
S ^TMP("SDWLRQ1",$J,"OPEN")=%
Q
FORM ;Report Format
S SDWLERR=0,DIR(0)="SO^1:D:Detailed;S:Summary",DIR("L",2)=" D Detailed"
S DIR("L")=" S Summary",DIR("L",1)="Select One of the Following: "
D ^DIR
S SDWLFORM=$S(X["D":"D",X["d":"D",X["S":"S",X["s":"S",1:"")
I X="^" S DUOUT=1 Q
I SDWLFORM="" W *7,"Required!" G FORM
S ^TMP("SDWLRQ1",$J,"FORM")=SDWLFORM
Q
DIS ;Display Parameters
S SDWLERR=0 W !!,?80-$L("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters ***",!
F SDWLI="INS","CT1","CT2","DATE","FORM","OPEN" D
.S X="SDWL"_SDWLI,@X=$G(^TMP("SDWLRQ1",$J,SDWLI))
F SDWLTAG="IS","CT","DA","OP","PR" D @SDWLTAG
Q
IS I SDWLINS'["ALL" D
.K SDWLY F I=1:1 S SDWLY=$P($P(SDWLINS,";",I),U,2) Q:SDWLY="" S SDWLY(I)=SDWLY
.W !,?20,"Institution: "
.I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?33 W SDWLY(I)
.K SDWLY
I SDWLINS["ALL" W !,?20,"Institution: ALL "
Q
CT I SDWLCT2'["ALL" D
.S SDWLF=$P(SDWLCT1,U,2)
.K SDWLY F I=1:1 S SDWLY=$P($P(SDWLCT2,";",I),U,2) Q:SDWLY="" S SDWLY(I)=SDWLY
.W !,?16,"Report Category: " W $S(SDWLCT1["C":"Clinic",1:"Service Specialty"),!,?36 I @X="ALL" W "All "
.I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?35 W $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I))
I SDWLCT2["ALL" W !,?16,"Report Category: " W $S(SDWLCT1["C":"Clinic",1:"Service Specialty"),!,?36 W "ALL "
Q
DA W !,?13,"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
I SDWLED'="" W " to ",SDWLED
Q
OP W !,?18,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary")
Q
PR I SDWLOPEN=1 W !,?25,"Printing 'OPEN' Entries Only."
E W !,?25,"Printing ALL Entries."
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 SDWLERR S DIR(0)="E" D ^DIR I X["^" S SDWLERR=2
Q
QUE ;Queue Report
N ZTQUEUED,POP
K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP QUE1
S ZTRTN=$S(SDWLFORM="D":"EN^SDWLRPT1",1:"EN^SDWLRPS1"),ZTDTH=$H,ZTDESC="WAIT LIST REPORT FORMAT 1"
S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLRQ1",$J,SDWLTASK)) Q:SDWLTASK="" D
.S SDWLTK=$G(^TMP("SDWLRQ1",$J,SDWLTASK))
.S ZTSAVE(SDWLTASK)=SDWLTK
S ZTSAVE("SDWLF")="" ; SD*5.3*412
I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END
QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
;
END ;
K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI,I
K DIR,DIC,DR,DIE,SDWLERR,SDWLF,SDWLX,SDLFD,SDWLCTX,SDWLDAT,SDWLPROM,SDWLINST,SDWLI,SDWLTAG,SDWLY
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
HD W:$D(IOF) @IOF W !,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
Q
SDWLRQ1 ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT;06/12/2002 ; 20 Aug 2002 2:10 PM
+1 ;;5.3;scheduling;**263,399,412,425,448,1015**;AUG 13 1993;Build 21
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ;
+12 ;
EN ;Header
+1 NEW ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+2 DO HD
+3 SET SDWLINST=""
SET SDWLERR=0
KILL ^TMP("SDWLRQ1",$JOB),DIC,DIR,DR,DIE
1 DO INS
IF $DATA(DUOUT)
GOTO END
2 DO CAT
IF SDWLERR
GOTO 1
IF $DATA(DUOUT)
GOTO 2
3 DO DATE
IF SDWLERR
GOTO 2
IF $DATA(DUOUT)
GOTO END
4 DO OPEN
IF SDWLERR
GOTO 3
IF $DATA(DUOUT)
GOTO 3
5 DO FORM
IF SDWLERR
GOTO 4
IF $DATA(DUOUT)
GOTO 4
6 DO DIS
IF SDWLERR=1
GOTO EN
IF SDWLERR=2
GOTO END
+1 DO QUE
+2 QUIT
INS ;Get Institution
+1 NEW SDWLINST
SET SDWLINST=""
+2 SET SDWLERR=0
SET SDWLPROM="Select Institution ALL // "
IN WRITE !
SET DIC(0)="QEMA"
SET DIC("A")=SDWLPROM
SET DIC=4
SET DIC("S")="I $D(^SDWL(409.32,""C"",+Y))!($D(^SDWL(409.31,""E"",+Y)))!($D(^SCTM(404.51,""AINST"",+Y)))"
DO ^DIC
IF Y<0
IF 'SDWLERR
IF $DATA(DUOUT)
QUIT
SET Y="ALL"
+1 IF Y<0
GOTO IN2
IF $DATA(DUOUT)
QUIT
+2 IF Y<0
SET SDWLINST=$SELECT(Y="ALL":"ALL",Y="":"ALL",Y="all":"ALL",Y="All":"ALL",Y["A":"ALL",Y["a":"ALL")
+3 IF Y="All"!(Y="")!(Y="all")!(Y="ALL")
SET SDWLINST="ALL"
SET ^TMP("SDWLRQ1",$JOB,"INS")="ALL"
GOTO IN3
+4 SET SDWLINST=SDWLINST_Y_";"
SET SDWLPROM="Another Institution: "
SET SDWLERR=1
GOTO IN
IN2 SET ^TMP("SDWLRQ1",$JOB,"INS")=SDWLINST
IN3 QUIT
CAT ;Report category selection
+1 KILL DIR,DIE,DR,DIC
+2 WRITE !!," *** Report Category Selection ***"
SET SDWLERR=0
+3 SET SDWLERR=0
SET SDWLCAT=""
SET DIR(0)="SO^1:Clinic;2:Select Service/Specialty"
SET DIR("L",1)=" 1. Clinic"
SET DIR("L")=" 2. Service/Specialty"
+4 DO ^DIR
+5 IF X="^"
SET SDWLERR=1
WRITE *7
QUIT
+6 IF X=""
SET SDWLERR=1
WRITE *7
QUIT
+7 SET X=$SELECT(X["C":"C",X["c":"C",X["S":"S",X["s":"S",X=1:"C",X=2:"S",1:"")
+8 IF X=""
WRITE *7," Invalid Selection."
GOTO CAT
+9 WRITE !!,"Select Category for Report Output",!
+10 SET SDWLX=$SELECT(X="C":"Clinic: ALL// ",X="S":"Service/Specialty: ALL// ")
+11 SET SDWLF=$SELECT(X["C":409.32,X["S":409.31,X["c":409.32,X["s":409.31)
+12 SET SDWLFD=$SELECT(X="C":8,1:7)
+13 SET SDWLCTX=X
+14 KILL DIR,DIC,DR
+15 SET ^TMP("SDWLRQ1",$JOB,"CT1")=SDWLCTX_"^"_SDWLF_"^"_SDWLFD
SET DIC("A")=SDWLX
SET SDWLE=0
CT1 WRITE !
SET DIC(0)="QEMNZA"
SET DIC=SDWLF
DO ^DIC
IF 'SDWLE
IF Y<1
SET ^TMP("SDWLRQ1",$JOB,"CT2")="ALL"
GOTO CT3
+1 IF Y<0
IF '$DATA(^TMP("SDWLRQ1",$JOB,"CT1"))
WRITE !,"This Entry is Required."
GOTO CAT
+2 IF Y<0
GOTO CT2
+3 SET SDWLCAT=SDWLCAT_Y_";"
SET DIC("A")="Another "_$PIECE(SDWLX,":",1)_": "
SET SDWLE=1
GOTO CT1
CT2 IF '$DATA(SDWLCAT)
GOTO CT1
SET ^TMP("SDWLRQ1",$JOB,"CT2")=SDWLCAT
CT3 QUIT
DATE ;Date range selection
+1 KILL X,Y,%DT
+2 SET %=1
WRITE !!,"Print Report for ALL dates? "
DO YN^DICN
+3 IF %=1
SET ^TMP("SDWLRQ1",$JOB,"DATE")="ALL"
GOTO E1
+4 IF %=0
QUIT
+5 IF %=-1
QUIT
+6 SET SDWLERR=0
WRITE !
SET %DT="AE"
SET %DT("A")="Start with Desired Appointment Date: "
DO ^%DT
+7 IF X["^"
SET SDWLERR=1
QUIT
+8 IF Y<0
GOTO E1
SET SDWLBDT=Y
+9 IF $DATA(DUOUT)
QUIT
+10 SET %DT(0)=SDWLBDT
SET %DT("A")="End with Desired Appointment Date: "
DO ^%DT
IF Y<1
GOTO DATE
SET SDWLEDT=Y
KILL %DT(0),%DT("A")
+11 IF $DATA(DUOUT)
GOTO DATE
+12 IF SDWLEDT<SDWLBDT
WRITE !,"Beginning Date must be greater than Ending Date."
GOTO DATE
+13 SET ^TMP("SDWLRQ1",$JOB,"DATE")=SDWLBDT_"^"_SDWLEDT
QUIT
E1 QUIT
OPEN ;OPEN Wait List Entries
+1 SET %=1
WRITE !!,"Do you want only 'OPEN' Wait List Entries "
DO YN^DICN
+2 IF %=0
WRITE " Response must be 'YES' or 'NO'."
GOTO OPEN
+3 IF %=-1
SET SDWLERR=1
WRITE *7,"?? "
+4 SET ^TMP("SDWLRQ1",$JOB,"OPEN")=%
+5 QUIT
FORM ;Report Format
+1 SET SDWLERR=0
SET DIR(0)="SO^1:D:Detailed;S:Summary"
SET DIR("L",2)=" D Detailed"
+2 SET DIR("L")=" S Summary"
SET DIR("L",1)="Select One of the Following: "
+3 DO ^DIR
+4 SET SDWLFORM=$SELECT(X["D":"D",X["d":"D",X["S":"S",X["s":"S",1:"")
+5 IF X="^"
SET DUOUT=1
QUIT
+6 IF SDWLFORM=""
WRITE *7,"Required!"
GOTO FORM
+7 SET ^TMP("SDWLRQ1",$JOB,"FORM")=SDWLFORM
+8 QUIT
DIS ;Display Parameters
+1 SET SDWLERR=0
WRITE !!,?80-$LENGTH("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters ***",!
+2 FOR SDWLI="INS","CT1","CT2","DATE","FORM","OPEN"
Begin DoDot:1
+3 SET X="SDWL"_SDWLI
SET @X=$GET(^TMP("SDWLRQ1",$JOB,SDWLI))
End DoDot:1
+4 FOR SDWLTAG="IS","CT","DA","OP","PR"
DO @SDWLTAG
+5 QUIT
IS IF SDWLINS'["ALL"
Begin DoDot:1
+1 KILL SDWLY
FOR I=1:1
SET SDWLY=$PIECE($PIECE(SDWLINS,";",I),U,2)
IF SDWLY=""
QUIT
SET SDWLY(I)=SDWLY
+2 WRITE !,?20,"Institution: "
+3 IF $DATA(SDWLY)
SET I=""
FOR
SET I=$ORDER(SDWLY(I))
IF I=""
QUIT
IF I>1
WRITE !,?33
WRITE SDWLY(I)
+4 KILL SDWLY
End DoDot:1
+5 IF SDWLINS["ALL"
WRITE !,?20,"Institution: ALL "
+6 QUIT
CT IF SDWLCT2'["ALL"
Begin DoDot:1
+1 SET SDWLF=$PIECE(SDWLCT1,U,2)
+2 KILL SDWLY
FOR I=1:1
SET SDWLY=$PIECE($PIECE(SDWLCT2,";",I),U,2)
IF SDWLY=""
QUIT
SET SDWLY(I)=SDWLY
+3 WRITE !,?16,"Report Category: "
WRITE $SELECT(SDWLCT1["C":"Clinic",1:"Service Specialty"),!,?36
IF @X="ALL"
WRITE "All "
+4 IF $DATA(SDWLY)
SET I=""
FOR
SET I=$ORDER(SDWLY(I))
IF I=""
QUIT
IF I>1
WRITE !,?35
WRITE $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I))
End DoDot:1
+5 IF SDWLCT2["ALL"
WRITE !,?16,"Report Category: "
WRITE $SELECT(SDWLCT1["C":"Clinic",1:"Service Specialty"),!,?36
WRITE "ALL "
+6 QUIT
DA WRITE !,?13,"Date Desired 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
+1 WRITE " ",SDWLBD
+2 IF SDWLED'=""
WRITE " to ",SDWLED
+3 QUIT
OP WRITE !,?18,"Output Format: ",$SELECT(SDWLFORM="D":" Detailed",1:" Summary")
+1 QUIT
PR IF SDWLOPEN=1
WRITE !,?25,"Printing 'OPEN' Entries Only."
+1 IF '$TEST
WRITE !,?25,"Printing ALL Entries."
+2 SET %=1
WRITE !!,"Are these Parameters Correct "
DO YN^DICN
IF %=2
SET SDWLERR=1
WRITE !," This Report will NOT be queued to print."
+3 IF SDWLERR
SET DIR(0)="E"
DO ^DIR
IF X["^"
SET SDWLERR=2
+4 QUIT
QUE ;Queue Report
+1 NEW ZTQUEUED,POP
+2 KILL %ZIS,IOP,IOC,ZTIO
SET %ZIS="MQ"
DO ^%ZIS
IF POP
GOTO QUE1
+3 SET ZTRTN=$SELECT(SDWLFORM="D":"EN^SDWLRPT1",1:"EN^SDWLRPS1")
SET ZTDTH=$HOROLOG
SET ZTDESC="WAIT LIST REPORT FORMAT 1"
+4 SET SDWLTASK=""
FOR
SET SDWLTASK=$ORDER(^TMP("SDWLRQ1",$JOB,SDWLTASK))
IF SDWLTASK=""
QUIT
Begin DoDot:1
+5 SET SDWLTK=$GET(^TMP("SDWLRQ1",$JOB,SDWLTASK))
+6 SET ZTSAVE(SDWLTASK)=SDWLTK
End DoDot:1
+7 ; SD*5.3*412
SET ZTSAVE("SDWLF")=""
+8 IF $DATA(IO("Q"))
KILL IO("Q")
DO ^%ZTLOAD
WRITE !,"REQUEST QUEUED"
GOTO END
QUE1 IF $EXTRACT(IOST,1,2)="C-"
SET SDWLSPT=1
IF $DATA(ZTRTN)
USE IO
DO @ZTRTN
KILL SDWLSPT
+1 ;
END ;
+1 KILL SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI,I
+2 KILL DIR,DIC,DR,DIE,SDWLERR,SDWLF,SDWLX,SDLFD,SDWLCTX,SDWLDAT,SDWLPROM,SDWLINST,SDWLI,SDWLTAG,SDWLY
+3 DO ^%ZISC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
HD IF $DATA(IOF)
WRITE @IOF
WRITE !,?80-$LENGTH("Appointment Wait List Report")\2,"Appointment Wait List Report"
+1 QUIT
