ADGPTLQ.m

ADGPTLQ ; IHS/ADC/PDW/ENM - QUEUE PATIENT LIST ; [ 03/25/1999  11:48 AM ]

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

 ;

SELECT W @IOF,!!!!,"Print Patient List: ",!

 K DIR S DIR("A",1)="     1. By Ward with diagnosis "

 S DIR("A",2)="     2. By Ward with service "

 S DIR("A",3)="     3. Alphabetically by Patient Name "

 S DIR("A",4)="     4. As a Ward Worksheet"

 S DIR("A",5)=" "

SELECT1 S DIR("A")="Choose One",DIR(0)="NO^1:4" D ^DIR

 G END:$D(DIRUT),SELECT:Y=-1 S DGO=Y

 ;

 I DGO=3 S DGWST="A" G DEV  ;alphabetical list

 ;

WARD K DIR S DIR("A")="Print ALL Wards",DIR(0)="Y",DIR("B")="NO"

 D ^DIR G SELECT:$D(DTOUT),SELECT:$D(DUOUT)

 I Y=1 S DGWST="A" G DEV

 K DIR S DIR(0)="PO^42:EQMZ" D ^DIR G WARD:$D(DIRUT),WARD:Y=-1

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

 S DGWST=+Y

 ;

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

QUE K IO("Q") S ZTRTN="^ADGPTLC",ZTDESC="PRINT PATIENT LIST"

 S ZTSAVE("DGO")="",ZTSAVE("DGWST")=""

 D ^%ZTLOAD D ^%ZISC K ZTSK

 ;

END K Y,DIR,DGWST,DGO D HOME^%ZIS Q

ADGPTLQ   ; IHS/ADC/PDW/ENM - QUEUE PATIENT LIST ; [ 03/25/1999  11:48 AM ]

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

 +2       ;

SELECT     WRITE @IOF,!!!!,"Print Patient List: ",!

 +1        KILL DIR

           SET DIR("A",1)="     1. By Ward with diagnosis "

 +2        SET DIR("A",2)="     2. By Ward with service "

 +3        SET DIR("A",3)="     3. Alphabetically by Patient Name "

 +4        SET DIR("A",4)="     4. As a Ward Worksheet"

 +5        SET DIR("A",5)=" "

SELECT1    SET DIR("A")="Choose One"

           SET DIR(0)="NO^1:4"

           DO ^DIR

 +1        IF $DATA(DIRUT)

               GOTO END

           IF Y=-1

               GOTO SELECT

           SET DGO=Y

 +2       ;

 +3       ;alphabetical list

           IF DGO=3

               SET DGWST="A"

               GOTO DEV

 +4       ;

WARD       KILL DIR

           SET DIR("A")="Print ALL Wards"

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +1        DO ^DIR

           IF $DATA(DTOUT)

               GOTO SELECT

           IF $DATA(DUOUT)

               GOTO SELECT

 +2        IF Y=1

               SET DGWST="A"

               GOTO DEV

 +3        KILL DIR

           SET DIR(0)="PO^42:EQMZ"

           DO ^DIR

           IF $DATA(DIRUT)

               GOTO WARD

           IF Y=-1

               GOTO WARD

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

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

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

                   GOTO WARD

 +5        SET DGWST=+Y

 +6       ;

DEV        SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO END

           IF $DATA(IO("Q"))

               GOTO QUE

           GOTO ^ADGPTLC

QUE        KILL IO("Q")

           SET ZTRTN="^ADGPTLC"

           SET ZTDESC="PRINT PATIENT LIST"

 +1        SET ZTSAVE("DGO")=""

           SET ZTSAVE("DGWST")=""

 +2        DO ^%ZTLOAD

           DO ^%ZISC

           KILL ZTSK

 +3       ;

END        KILL Y,DIR,DGWST,DGO

           DO HOME^%ZIS

           QUIT