Routine: SRSWLST

SRSWLST ;B'HAM ISC/MAM - PRINT SURGERY WAITING LIST ; 17 OCT 89  7:05 AM

 ;;3.0; Surgery ;;24 Jun 93

 S SOPT="",SSOPT="",SRSS=""

 N DFN

 S RH="Surgery Waiting List Reports"

MENU W @IOF,!!,?(IOM-$L(RH)\2),RH,!!,"Print Report By:"

 W !!,"         A    Alphabetical Order by Patient",!,"         T    Tentative Date of Operation",!,"         D    Date Entered on the Waiting List"

 S SRSOUT=0 W !!,"Enter Selection (A,T, or D): " R SOPT:DTIME I '$T!(SOPT["^")!(SOPT="") S SRSOUT=1 W @IOF G END

 S SOPT=$E(SOPT) I "ATDatd"'[SOPT!(SOPT="") W !!,"Enter one of the letters, A, T, or D or ^ to exit. ",!!,"Press RETURN to continue  " R X:DTIME G MENU

SPEC S SRSOUT=0 W @IOF,!,"Do you want to print the waiting list for all specialties ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END

SORTOP I "Aa"[SOPT,"Yy"[SRYN W !!,"Do you want this alphabetic list to be sorted by surgical specialty ?  YES//  " R SSOPT:DTIME I '$T!(SSOPT["^") S SRSOUT=1 G END

 S SSOPT=$E(SSOPT)

 S:SSOPT="" SSOPT="Y" I "YyNn"'[SSOPT W !!,"Enter YES to generate the list sorted first by surgical specialty ",!,"and then alphabetic by patient name. Enter NO to sort only by patient name.",!!,"Press RETURN to continue  " R X:DTIME G SORTOP

 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter 'YES' if you want to generate the list for all surgical",!,"specialties, or 'NO' to select a specific specialty.",!!,"Press RETURN to continue  " R X:DTIME G SPEC

 I "Nn"[SRYN W ! K DIC S DIC=133.8,DIC(0)="QEAMZ",DIC("A")="Select Surgical Specialty:  " D ^DIC I Y<0 S SRSOUT=1 G END

 I "Nn"[SRYN S SRSS=+Y,SRSNM=$P(Y(0),"^") S SRSNM=$P(^SRO(137.45,SRSNM,0),"^") S ZTSAVE("SRSNM")=SRSNM,ZTSAVE("SRSS")=SRSS

 I "Yy"[SRYN S SRSS="ALL"

FORM ; brief or extended

 W !!,"Do you want to print the brief form ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END

 S SRYN=$E(SRYN) I SRYN="" S SRYN="Y"

 I "YyNn"'[SRYN W !!,"Enter 'NO' if you want to print the extended form of the waiting list",!,"containing demographic information, or 'YES' to print the brief form.",! G FORM

 S SRFORM=$S("Yy"[SRYN:"B",1:"E")

 ;;;  Sort by Patient within All Specialties displaying brief form.

 I "Aa"[SOPT,SRSS="ALL","Yy"[SSOPT,SRFORM="B" G ^SRSWL6

 ;;;  Sort by Patient within All Specialties displaying extended form.

 I "Aa"[SOPT,SRSS="ALL","Yy"[SSOPT G ^SRSWL7

 ;;;  Sort by Patient Only, displaying All Specialties, in brief form.

 I "Aa"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL8

 ;;;  Sort by Patient Only, displaying All Specialties, extended form.

 I "Aa"[SOPT,SRSS="ALL" G ^SRSWL9

 ;;;  Sort by Patient Only, displaying One Specialty, in brief form.

 I "Aa"[SOPT,SRSS'="ALL",SRFORM="B" G ^SRSWL10

 ;;;  Sort by Patient Only, displaying One Specialty, in extended form.

 I "Aa"[SOPT,SRSS'="ALL" G ^SRSWL11

 ;;;  Sort by Tentative Date of Operation within All Specialties Brief.

 I "Tt"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL12

 ;;;  Sort by Tentative Date of Operation within All Specialties Extend.

 I "Tt"[SOPT,SRSS="ALL" G ^SRSWL13

 ;;;  Sort by Tentative Date of Operation for one Specialty, Brief form.

 I "Tt"[SOPT,SRFORM="B" G ^SRSWL14

 ;;;  Sort by Tentative Date of Operation for one Specialty, Extended.

 I "Tt"[SOPT G ^SRSWL15

 ;;;  Sort by Date entered on the List with All specailties,brief form.

 I "Dd"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL1

 ;;;  Sort by Date entered on the List with All specailties, extended.

 I "Dd"[SOPT,SRSS="ALL" G ^SRSWL3

 ;;;  Sort by Date entered on the List for one specailty, brief form.

 I "Dd"[SOPT,SRFORM="B" G ^SRSWL2

 ;;;  Sort by Date entered on the List for one specialty, extended.

 I "Dd"[SOPT G ^SRSWL4

END I $E(IOST)="P" S SRSOUT=1 W @IOF

 I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME W @IOF

 D ^%ZISC,^SRSKILL

 K SRTN

OLD ; check for operations by same specialty

 S SRTN=0 F  S SRTN=$O(^SRF("B",DFN,SRTN)) Q:'SRTN  S SROLDDT=$P(^SRF(SRTN,0),"^",9) D CHK

CHK ;

 S X1=DT,X2=-30 D C^%DTC I SROLDDT<X Q

 I $D(^SRF(SRTN,.2)),$P(^(.2),"^",12) S Y=SROLDDT D D^DIQ S SROLD("DATE")=$P(Y,"@"),SROLD=SRTN

SRSWLST   ;B'HAM ISC/MAM - PRINT SURGERY WAITING LIST ; 17 OCT 89  7:05 AM

 +1       ;;3.0; Surgery ;;24 Jun 93

 +2        SET SOPT=""

           SET SSOPT=""

           SET SRSS=""

 +3        NEW DFN

 +4       ;

 +5        SET RH="Surgery Waiting List Reports"

MENU       WRITE @IOF,!!,?(IOM-$LENGTH(RH)\2),RH,!!,"Print Report By:"

 +1        WRITE !!,"         A    Alphabetical Order by Patient",!,"         T    Tentative Date of Operation",!,"         D    Date Entered on the Waiting List"

 +2       ;

 +3        SET SRSOUT=0

           WRITE !!,"Enter Selection (A,T, or D): "

           READ SOPT:DTIME

           IF '$TEST!(SOPT["^")!(SOPT="")

               SET SRSOUT=1

               WRITE @IOF

               GOTO END

 +4       ;

 +5        SET SOPT=$EXTRACT(SOPT)

           IF "ATDatd"'[SOPT!(SOPT="")

               WRITE !!,"Enter one of the letters, A, T, or D or ^ to exit. ",!!,"Press RETURN to continue  "

               READ X:DTIME

               GOTO MENU

 +6       ;

 +7       ;

SPEC       SET SRSOUT=0

           WRITE @IOF,!,"Do you want to print the waiting list for all specialties ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               GOTO END

 +1       ;

SORTOP     IF "Aa"[SOPT

               IF "Yy"[SRYN

                   WRITE !!,"Do you want this alphabetic list to be sorted by surgical specialty ?  YES//  "

                   READ SSOPT:DTIME

                   IF '$TEST!(SSOPT["^")

                       SET SRSOUT=1

                       GOTO END

 +1        SET SSOPT=$EXTRACT(SSOPT)

 +2        IF SSOPT=""

               SET SSOPT="Y"

           IF "YyNn"'[SSOPT

               WRITE !!,"Enter YES to generate the list sorted first by surgical specialty ",!,"and then alphabetic by patient name. Enter NO to sort only by patient name.",!!,"Press RETURN to continue  "

               READ X:DTIME

               GOTO SORTOP

 +3        SET SRYN=$EXTRACT(SRYN)

           IF SRYN=""

               SET SRYN="Y"

           IF "YyNn"'[SRYN

               WRITE !!,"Enter 'YES' if you want to generate the list for all surgical",!,"specialties, or 'NO' to select a specific specialty.",!!,"Press RETURN to continue  "

               READ X:DTIME

               GOTO SPEC

 +4       ;

 +5        IF "Nn"[SRYN

               WRITE !

               KILL DIC

               SET DIC=133.8

               SET DIC(0)="QEAMZ"

               SET DIC("A")="Select Surgical Specialty:  "

               DO ^DIC

               IF Y<0

                   SET SRSOUT=1

                   GOTO END

 +6        IF "Nn"[SRYN

               SET SRSS=+Y

               SET SRSNM=$PIECE(Y(0),"^")

               SET SRSNM=$PIECE(^SRO(137.45,SRSNM,0),"^")

               SET ZTSAVE("SRSNM")=SRSNM

               SET ZTSAVE("SRSS")=SRSS

 +7       ;

 +8        IF "Yy"[SRYN

               SET SRSS="ALL"

FORM      ; brief or extended

 +1       ;

 +2        WRITE !!,"Do you want to print the brief form ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               GOTO END

 +3       ;

 +4        SET SRYN=$EXTRACT(SRYN)

           IF SRYN=""

               SET SRYN="Y"

 +5       ;

 +6        IF "YyNn"'[SRYN

               WRITE !!,"Enter 'NO' if you want to print the extended form of the waiting list",!,"containing demographic information, or 'YES' to print the brief form.",!

               GOTO FORM

 +7       ;

 +8        SET SRFORM=$SELECT("Yy"[SRYN:"B",1:"E")

 +9       ;

 +10      ;;;  Sort by Patient within All Specialties displaying brief form.

 +11       IF "Aa"[SOPT

               IF SRSS="ALL"

                   IF "Yy"[SSOPT

                       IF SRFORM="B"

                           GOTO ^SRSWL6

 +12      ;;;  Sort by Patient within All Specialties displaying extended form.

 +13       IF "Aa"[SOPT

               IF SRSS="ALL"

                   IF "Yy"[SSOPT

                       GOTO ^SRSWL7

 +14      ;;;  Sort by Patient Only, displaying All Specialties, in brief form.

 +15       IF "Aa"[SOPT

               IF SRSS="ALL"

                   IF SRFORM="B"

                       GOTO ^SRSWL8

 +16      ;;;  Sort by Patient Only, displaying All Specialties, extended form.

 +17       IF "Aa"[SOPT

               IF SRSS="ALL"

                   GOTO ^SRSWL9

 +18      ;;;  Sort by Patient Only, displaying One Specialty, in brief form.

 +19       IF "Aa"[SOPT

               IF SRSS'="ALL"

                   IF SRFORM="B"

                       GOTO ^SRSWL10

 +20      ;;;  Sort by Patient Only, displaying One Specialty, in extended form.

 +21       IF "Aa"[SOPT

               IF SRSS'="ALL"

                   GOTO ^SRSWL11

 +22      ;;;  Sort by Tentative Date of Operation within All Specialties Brief.

 +23       IF "Tt"[SOPT

               IF SRSS="ALL"

                   IF SRFORM="B"

                       GOTO ^SRSWL12

 +24      ;;;  Sort by Tentative Date of Operation within All Specialties Extend.

 +25       IF "Tt"[SOPT

               IF SRSS="ALL"

                   GOTO ^SRSWL13

 +26      ;;;  Sort by Tentative Date of Operation for one Specialty, Brief form.

 +27       IF "Tt"[SOPT

               IF SRFORM="B"

                   GOTO ^SRSWL14

 +28      ;;;  Sort by Tentative Date of Operation for one Specialty, Extended.

 +29       IF "Tt"[SOPT

               GOTO ^SRSWL15

 +30      ;;;  Sort by Date entered on the List with All specailties,brief form.

 +31       IF "Dd"[SOPT

               IF SRSS="ALL"

                   IF SRFORM="B"

                       GOTO ^SRSWL1

 +32      ;;;  Sort by Date entered on the List with All specailties, extended.

 +33       IF "Dd"[SOPT

               IF SRSS="ALL"

                   GOTO ^SRSWL3

 +34      ;;;  Sort by Date entered on the List for one specailty, brief form.

 +35       IF "Dd"[SOPT

               IF SRFORM="B"

                   GOTO ^SRSWL2

 +36      ;;;  Sort by Date entered on the List for one specialty, extended.

 +37       IF "Dd"[SOPT

               GOTO ^SRSWL4

 +38      ;

END        IF $EXTRACT(IOST)="P"

               SET SRSOUT=1

               WRITE @IOF

 +1        IF $DATA(ZTQUEUED)

               KILL ^TMP("SR",$JOB)

               IF $GET(ZTSTOP)

                   QUIT

               SET ZTREQ="@"

               QUIT

 +2        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

               WRITE @IOF

 +3        DO ^%ZISC

           DO ^SRSKILL

 +4        KILL SRTN

 +5        QUIT

OLD       ; check for operations by same specialty

 +1       ;

 +2        SET SRTN=0

FOR

               SET SRTN=$ORDER(^SRF("B",DFN,SRTN))

               IF 'SRTN

                   QUIT

               SET SROLDDT=$PIECE(^SRF(SRTN,0),"^",9)

               DO CHK

 +3        QUIT

CHK       ;

 +1        SET X1=DT

           SET X2=-30

           DO C^%DTC

           IF SROLDDT<X

               QUIT

 +2       ;

 +3        IF $DATA(^SRF(SRTN,.2))

               IF $PIECE(^(.2),"^",12)

                   SET Y=SROLDDT

                   DO D^DIQ

                   SET SROLD("DATE")=$PIECE(Y,"@")

                   SET SROLD=SRTN

 +4        QUIT

SRSWLST.m