ADGRALQ.m

ADGRALQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF READMISSIONS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 W @IOF W !!!?20,"PRINT LIST OF READMISSIONS",!!

 ;

 ;***> select date range

DATE S %DT="AEQ",%DT("A")="Beginning date: ",X="" D ^%DT

 G END:Y=-1 S DGBDT=Y

DATE2 S %DT="AEQ",%DT("A")="Ending date: ",X="" D ^%DT G DATE:Y=-1 S DGEDT=Y

 I DGEDT<DGBDT W *7,!!?5,"Ending date MUST NOT be before beginning date",! G DATE2

 I DGEDT'<DT S X1=DT,X2=-1 D C^%DTC S DGEDT=X

 ;

 ;***> select type of report

TYPE K DIR S DIR("A",1)="Select Sorting Order for Report:"

 S DIR("A",2)="     1.  By DATE",DIR("A",3)="     2.  By WARD"

 S DIR("A",4)="     3.  By SERVICE"

SELECT S DIR("A")="Select (1, 2, or 3):  ",DIR(0)="NAO^1:3" D ^DIR

 G END:$D(DTOUT),DATE2:X="",END:$D(DUOUT),TYPE:Y=-1 S DGTYP=Y

 G DEV:DGTYP=1

 ;

ALL ;***> choose one or all wards or services

 K DIR S DIR(0)="Y"

 S DIR("A")=$S(DGTYP=2:"Print for All Wards",1:"Print for All Services")

 S DIR("B")="NO" D ^DIR I Y=1 S DGSRT="A" G DEV  ;all wards or serv

 I $D(DIRUT) G END  ;check for timeout,"^", or null

 ;

ONE ;***> choose which ward or service to print

 K DIR S DIR(0)=$S(DGTYP=2:"PO^42:EMQZ",1:"PO^45.7:EMQZ") D ^DIR

 G END:$D(DTOUT),ALL:X="",END:$D(DUOUT),ONE:Y=-1

 I DGTYP=2 I $D(^DIC(42,+Y,"I")),$P(^("I"),U)="I" W *7,?40,"** INACTIVE WARD **" G ONE

 I DGTYP=3 I $P(^DIC(45.7,+Y,9999999),U,3)'="Y" W *7,!?35,"** NOT AN ADMITTING SERVICE! **" G ONE

 S DGSRT=Y

 ;

 ;***> select print device

DEV S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^ADGRALC

QUE K IO("Q") S ZTRTN="^ADGRALC" S ZTDESC="READMITS LISTING"

 F DGI="DGBDT","DGEDT","DGTYP","DGSRT" S ZTSAVE(DGI)=""

 D ^%ZTLOAD D ^%ZISC K ZTSK

 ;

END K Y,DGBDT,DGEDT,DGTYP,DGSRT,DIR,DGI D HOME^%ZIS Q

ADGRALQ   ; IHS/ADC/PDW/ENM - QUEUE LIST OF READMISSIONS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3        WRITE @IOF

           WRITE !!!?20,"PRINT LIST OF READMISSIONS",!!

 +4       ;

 +5       ;***> select date range

DATE       SET %DT="AEQ"

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

           SET X=""

           DO ^%DT

 +1        IF Y=-1

               GOTO END

           SET DGBDT=Y

DATE2      SET %DT="AEQ"

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

           SET X=""

           DO ^%DT

           IF Y=-1

               GOTO DATE

           SET DGEDT=Y

 +1        IF DGEDT<DGBDT

               WRITE *7,!!?5,"Ending date MUST NOT be before beginning date",!

               GOTO DATE2

 +2        IF DGEDT'<DT

               SET X1=DT

               SET X2=-1

               DO C^%DTC

               SET DGEDT=X

 +3       ;

 +4       ;***> select type of report

TYPE       KILL DIR

           SET DIR("A",1)="Select Sorting Order for Report:"

 +1        SET DIR("A",2)="     1.  By DATE"

           SET DIR("A",3)="     2.  By WARD"

 +2        SET DIR("A",4)="     3.  By SERVICE"

SELECT     SET DIR("A")="Select (1, 2, or 3):  "

           SET DIR(0)="NAO^1:3"

           DO ^DIR

 +1        IF $DATA(DTOUT)

               GOTO END

           IF X=""

               GOTO DATE2

           IF $DATA(DUOUT)

               GOTO END

           IF Y=-1

               GOTO TYPE

           SET DGTYP=Y

 +2        IF DGTYP=1

               GOTO DEV

 +3       ;

ALL       ;***> choose one or all wards or services

 +1        KILL DIR

           SET DIR(0)="Y"

 +2        SET DIR("A")=$SELECT(DGTYP=2:"Print for All Wards",1:"Print for All Services")

 +3       ;all wards or serv

           SET DIR("B")="NO"

           DO ^DIR

           IF Y=1

               SET DGSRT="A"

               GOTO DEV

 +4       ;check for timeout,"^", or null

           IF $DATA(DIRUT)

               GOTO END

 +5       ;

ONE       ;***> choose which ward or service to print

 +1        KILL DIR

           SET DIR(0)=$SELECT(DGTYP=2:"PO^42:EMQZ",1:"PO^45.7:EMQZ")

           DO ^DIR

 +2        IF $DATA(DTOUT)

               GOTO END

           IF X=""

               GOTO ALL

           IF $DATA(DUOUT)

               GOTO END

           IF Y=-1

               GOTO ONE

 +3        IF DGTYP=2

               IF $DATA(^DIC(42,+Y,"I"))

                   IF $PIECE(^("I"),U)="I"

                       WRITE *7,?40,"** INACTIVE WARD **"

                       GOTO ONE

 +4        IF DGTYP=3

               IF $PIECE(^DIC(45.7,+Y,9999999),U,3)'="Y"

                   WRITE *7,!?35,"** NOT AN ADMITTING SERVICE! **"

                   GOTO ONE

 +5        SET DGSRT=Y

 +6       ;

 +7       ;***> select print device

DEV        SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO END

           IF $DATA(IO("Q"))

               GOTO QUE

           USE IO

           GOTO ^ADGRALC

QUE        KILL IO("Q")

           SET ZTRTN="^ADGRALC"

           SET ZTDESC="READMITS LISTING"

 +1        FOR DGI="DGBDT","DGEDT","DGTYP","DGSRT"

               SET ZTSAVE(DGI)=""

 +2        DO ^%ZTLOAD

           DO ^%ZISC

           KILL ZTSK

 +3       ;

END        KILL Y,DGBDT,DGEDT,DGTYP,DGSRT,DIR,DGI

           DO HOME^%ZIS

           QUIT