- 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
