SDWLQOF.m

SDWLQOF ;;IOFO BAY PINES/TEH - OVERDUE APPOINTMENT

 ;;5.3;scheduling;**263,414,425,448**;AUG 13 1993

 ;

 ;

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

 ;                             CHANGE LOG

 ;                                               

 ;   DATE                        PATCH                   DESCRIPTION

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

 ;

EN ;Header

 N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,SDWLSPT

 D HD

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

1 D INS G END:$D(DUOUT)

2 D CAT G 1:SDWLERR,END:$D(DUOUT)

3 D FORM G 2:SDWLERR,END:$D(DUOUT)

4 D DIS G EN:SDWLERR=1,END:SDWLERR=2

 D QUE

 Q

INS ;Get Institution

 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("SDWLQOF",$J,"INS")="ALL" G IN3

 S SDWLPROM="Another Institution: ",SDWLERR=1

 G IN:$D(SDWLIN(+Y)) S SDWLIN(+Y)=""

 S SDWLINST=SDWLINST_Y_";",SDWLPROM="Another Institution: ",SDWLERR=1 G IN

IN2 S ^TMP("SDWLQOF",$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("SDWLQOF",$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("SDWLQOF",$J,"CT2")="ALL" G CT3

 I Y<0,'$D(^TMP("SDWLQOF",$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("SDWLQOF",$J,"CT2")=SDWLCAT

CT3 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

 I X="^" S DUOUT=1 Q

 S SDWLFORM=$S(X["D":"D",X["d":"D",X["S":"S",X["s":"S",1:"")

 I X="" W !,"Required!" G FORM

 S ^TMP("SDWLQOF",$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","FORM" D

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

 F SDWLTAG="IS","CT","OP" 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

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

 Q

 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^SDWLROF",1:"EN^SDWLROS"),ZTDTH=$H,ZTDESC="WAIT LIST OVERDUE REPORT"

 S SDWLTASK="" F  S SDWLTASK=$O(^TMP("SDWLQOF",$J,SDWLTASK)) Q:SDWLTASK=""  D

 .S SDWLTK=$G(^TMP("SDWLQOF",$J,SDWLTASK))

 .S ZTSAVE(SDWLTASK)=SDWLTK

 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

 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 Q

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

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDWLQOF   4789     printed  Mar 13, 2025@22:08:03                                                                                                                                                                                                     Page 2

SDWLQOF   ;;IOFO BAY PINES/TEH - OVERDUE APPOINTMENT

 +1       ;;5.3;scheduling;**263,414,425,448**;AUG 13 1993

 +2       ;

 +3       ;

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

 +5       ;                             CHANGE LOG

 +6       ;                                               

 +7       ;   DATE                        PATCH                   DESCRIPTION

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

 +9       ;

EN        ;Header

 +1        NEW ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,SDWLSPT

 +2        DO HD

 +3        SET SDWLINST=""

           SET SDWLERR=0

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

1          DO INS

           if $DATA(DUOUT)

               GOTO END

2          DO CAT

           if SDWLERR

               GOTO 1

           if $DATA(DUOUT)

               GOTO END

3          DO FORM

           if SDWLERR

               GOTO 2

           if $DATA(DUOUT)

               GOTO END

4          DO DIS

           if SDWLERR=1

               GOTO EN

           if SDWLERR=2

               GOTO END

 +1        DO QUE

 +2        QUIT 

INS       ;Get Institution

 +1        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("SDWLQOF",$JOB,"INS")="ALL"

               GOTO IN3

 +4        SET SDWLPROM="Another Institution: "

           SET SDWLERR=1

 +5        if $DATA(SDWLIN(+Y))

               GOTO IN

           SET SDWLIN(+Y)=""

 +6        SET SDWLINST=SDWLINST_Y_";"

           SET SDWLPROM="Another Institution: "

           SET SDWLERR=1

           GOTO IN

IN2        SET ^TMP("SDWLQOF",$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("SDWLQOF",$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("SDWLQOF",$JOB,"CT2")="ALL"

                   GOTO CT3

 +1        IF Y<0

               IF '$DATA(^TMP("SDWLQOF",$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("SDWLQOF",$JOB,"CT2")=SDWLCAT

CT3        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        IF X="^"

               SET DUOUT=1

               QUIT 

 +5        SET SDWLFORM=$SELECT(X["D":"D",X["d":"D",X["S":"S",X["s":"S",1:"")

 +6        IF X=""

               WRITE !,"Required!"

               GOTO FORM

 +7        SET ^TMP("SDWLQOF",$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","FORM"

               Begin DoDot:1

 +3                SET X="SDWL"_SDWLI

                   SET @X=$GET(^TMP("SDWLQOF",$JOB,SDWLI))

               End DoDot:1

 +4        FOR SDWLTAG="IS","CT","OP"

               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 

OP         WRITE !,?18,"Output Format: ",$SELECT(SDWLFORM="D":" Detailed",1:" Summary")

 +1        QUIT 

 +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^SDWLROF",1:"EN^SDWLROS")

           SET ZTDTH=$HOROLOG

           SET ZTDESC="WAIT LIST OVERDUE REPORT"

 +4        SET SDWLTASK=""

           FOR 

               SET SDWLTASK=$ORDER(^TMP("SDWLQOF",$JOB,SDWLTASK))

               if SDWLTASK=""

                   QUIT 

               Begin DoDot:1

 +5                SET SDWLTK=$GET(^TMP("SDWLQOF",$JOB,SDWLTASK))

 +6                SET ZTSAVE(SDWLTASK)=SDWLTK

               End DoDot:1

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

 +3        DO ^%ZISC

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        QUIT 

HD         if $DATA(IOF)

               WRITE @IOF

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

 +1        QUIT