Routine: AQACQRI

AQACQRI ;IHS/ASU/RPL;QUARTERLY REPORT PRINTOUTS FOR IHS INPATIENT REGISTER; [ 06/20/88  11:48 AM ] ; 11/8/89  8:34 AM

 ;;IHS QA/UR Version 2.04;11/7/89

 W !!,"Quarterly Report Printouts for IHS Inpatient Register",!!

RSTART R "Start with report number (2-17)? ",AQACNBR:$S($D(DTIME)#2:DTIME,1:3600) G QUIT:'$T!(AQACNBR="^")

 I AQACNBR'?1.2N!(AQACNBR<2)!(AQACNBR>17)!(AQACNBR="?") W !!,"Enter the number of the report to start printing with, from 2 through 17.",!,"All reports will print in order, starting with the one you choose.",!,"Enter ""^"" to quit.",!! G RSTART

 W !! S AQASNO="ENT"_AQACNBR

 D START G:'$D(AQACIOP) QUIT G:$D(IO("Q")) QUE G PRNOW

PRQUE ;Enter from TaskManager

 S AQAZTSK=ZTSK G:$D(AQACIOP) PRNOW

 F AQAG="AQACIOP","AQASD","AQASD1","AQAFD","AQAFD1","AQASNO","DUZ(2)","DUZ(0)" S @AQAG=^%ZTSK(ZTSK,0,AQAG)

PRNOW D @AQASNO G QUIT

START1 W !!,"Quarterly Report Printouts for IHS Inpatient Register",!!

START ;

AQASD S %DT("A")="Enter QUARTERLY REPORT STARTING DATE: ",%DT="AEPX" D ^%DT Q:Y<0  S AQASD=Y X ^DD("DD") S AQASD1=Y

AQAFD S %DT("A")="Enter QUARTERLY REPORT ENDING DATE: ",%DT="AEPX" D ^%DT Q:Y<0  S AQAFD=Y X ^DD("DD") S AQAFD1=Y

DEV W ! S %IS("B")="",%IS="Q" D ^%ZIS Q:'$D(IO)!(POP=1)

 S AQACIOP=IO

 W:'$D(IO("Q")) !!,"I'M WORKIN, BOSS!",!! Q

QUE K IO("Q") S ZTRTN="PRQUE^AQACQRI",ZTDESC="IHS QUARTERLY REPORTS" F AQAG="AQASNO","AQASD","AQASD1","AQAFD","AQAFD1","AQACIOP","DUZ(2)","DUZ(0)" S ZTSAVE(AQAG)=""

 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! G QUIT

PRT S IOP=AQACIOP_";"_80,PG=1,DOUT=$I D EN1^DIP

 S IOP=AQACIOP D ^%ZIS I $E(IOST)="P" U AQACIOP W @IOF X ^%ZIS("C")

ENT2 D R2^AQACQRI1

ENT3 D R3^AQACQRI1

ENT4 D R4^AQACQRI1

ENT5 D R5^AQACQRI1

ENT6 D R6^AQACQRI1

ENT7 D R7^AQACQRI1

ENT8 D R8^AQACQRI1

ENT9 D R9^AQACQRI1

ENT10 D R10^AQACQRI1

ENT11 D R11^AQACQRI2

ENT12 D R12^AQACQRI2

ENT13 D R13^AQACQRI2

ENT14 D R14^AQACQRI2

ENT15 D R15^AQACQRI2

ENT16 D R16^AQACQRI2

ENT17 D R17^AQACQRI2

EN2 ;

 S AQASNO="R2^AQACQRI1" G SINGLE

EN3 ;

 S AQASNO="R3^AQACQRI1" G SINGLE

EN4 ;

 S AQASNO="R4^AQACQRI1" G SINGLE

EN5 ;

 S AQASNO="R5^AQACQRI1" G SINGLE

EN6 ;

 S AQASNO="R6^AQACQRI1" G SINGLE

EN7 ;

 S AQASNO="R7^AQACQRI1" G SINGLE

EN8 ;

 S AQASNO="R8^AQACQRI1" G SINGLE

EN9 ;

 S AQASNO="R9^AQACQRI1" G SINGLE

EN10 ;

 S AQASNO="R10^AQACQRI1" G SINGLE

EN11 ;

 S AQASNO="R11^AQACQRI2" G SINGLE

EN12 ;

 S AQASNO="R12^AQACQRI2" G SINGLE

EN13 ;

 S AQASNO="R13^AQACQRI2" G SINGLE

EN14 ;

 S AQASNO="R14^AQACQRI2" G SINGLE

EN15 ;

 S AQASNO="R15^AQACQRI2" G SINGLE

EN16 ;

 S AQASNO="R16^AQACQRI2" G SINGLE

EN17 ;

 S AQASNO="R17^AQACQRI2" G SINGLE

SINGLE D START1 G:$D(IO("Q")) QUE G:$D(AQACIOP) PRNOW G QUIT

QUIT K %DT,DTOUT,AQACNBR,AQASNO,AQACIOP,AQASD,AQASD1,AQAFD,AQAFD1,AQAG,ZTSK I $D(AQAZTSK),$D(^%ZTSK(AQAZTSK)) K ^%ZTSK(AQAZTSK),AQAZTSK

AQACQRI   ;IHS/ASU/RPL;QUARTERLY REPORT PRINTOUTS FOR IHS INPATIENT REGISTER; [ 06/20/88  11:48 AM ] ; 11/8/89  8:34 AM

 +1       ;;IHS QA/UR Version 2.04;11/7/89

 +2        WRITE !!,"Quarterly Report Printouts for IHS Inpatient Register",!!

RSTART     READ "Start with report number (2-17)? ",AQACNBR:$SELECT($DATA(DTIME)#2:DTIME,1:3600)

           IF '$TEST!(AQACNBR="^")

               GOTO QUIT

 +1        IF AQACNBR'?1.2N!(AQACNBR<2)!(AQACNBR>17)!(AQACNBR="?")

               WRITE !!,"Enter the number of the report to start printing with, from 2 through 17.",!,"All reports will print in order, starting with the one you choose.",!,"Enter ""^"" to quit.",!!

               GOTO RSTART

 +2        WRITE !!

           SET AQASNO="ENT"_AQACNBR

 +3        DO START

           IF '$DATA(AQACIOP)

               GOTO QUIT

           IF $DATA(IO("Q"))

               GOTO QUE

           GOTO PRNOW

PRQUE     ;Enter from TaskManager

 +1        SET AQAZTSK=ZTSK

           IF $DATA(AQACIOP)

               GOTO PRNOW

 +2        FOR AQAG="AQACIOP","AQASD","AQASD1","AQAFD","AQAFD1","AQASNO","DUZ(2)","DUZ(0)"

               SET @AQAG=^%ZTSK(ZTSK,0,AQAG)

PRNOW      DO @AQASNO

           GOTO QUIT

START1     WRITE !!,"Quarterly Report Printouts for IHS Inpatient Register",!!

START     ;

AQASD      SET %DT("A")="Enter QUARTERLY REPORT STARTING DATE: "

           SET %DT="AEPX"

           DO ^%DT

           IF Y<0

               QUIT

           SET AQASD=Y

           XECUTE ^DD("DD")

           SET AQASD1=Y

AQAFD      SET %DT("A")="Enter QUARTERLY REPORT ENDING DATE: "

           SET %DT="AEPX"

           DO ^%DT

           IF Y<0

               QUIT

           SET AQAFD=Y

           XECUTE ^DD("DD")

           SET AQAFD1=Y

DEV        WRITE !

           SET %IS("B")=""

           SET %IS="Q"

           DO ^%ZIS

           IF '$DATA(IO)!(POP=1)

               QUIT

 +1        SET AQACIOP=IO

 +2        IF '$DATA(IO("Q"))

               WRITE !!,"I'M WORKIN, BOSS!",!!

           QUIT

QUE        KILL IO("Q")

           SET ZTRTN="PRQUE^AQACQRI"

           SET ZTDESC="IHS QUARTERLY REPORTS"

           FOR AQAG="AQASNO","AQASD","AQASD1","AQAFD","AQAFD1","AQACIOP","DUZ(2)","DUZ(0)"

               SET ZTSAVE(AQAG)=""

 +1        DO ^%ZTLOAD

           IF $DATA(ZTSK)

               WRITE !,"REQUEST QUEUED!",!

           GOTO QUIT

PRT        SET IOP=AQACIOP_";"_80

           SET PG=1

           SET DOUT=$IO

           DO EN1^DIP

 +1        SET IOP=AQACIOP

           DO ^%ZIS

           IF $EXTRACT(IOST)="P"

               USE AQACIOP

               WRITE @IOF

               XECUTE ^%ZIS("C")

 +2        QUIT

ENT2       DO R2^AQACQRI1

ENT3       DO R3^AQACQRI1

ENT4       DO R4^AQACQRI1

ENT5       DO R5^AQACQRI1

ENT6       DO R6^AQACQRI1

ENT7       DO R7^AQACQRI1

ENT8       DO R8^AQACQRI1

ENT9       DO R9^AQACQRI1

ENT10      DO R10^AQACQRI1

ENT11      DO R11^AQACQRI2

ENT12      DO R12^AQACQRI2

ENT13      DO R13^AQACQRI2

ENT14      DO R14^AQACQRI2

ENT15      DO R15^AQACQRI2

ENT16      DO R16^AQACQRI2

ENT17      DO R17^AQACQRI2

 +1        QUIT

 +2       ;

EN2       ;

 +1        SET AQASNO="R2^AQACQRI1"

           GOTO SINGLE

EN3       ;

 +1        SET AQASNO="R3^AQACQRI1"

           GOTO SINGLE

EN4       ;

 +1        SET AQASNO="R4^AQACQRI1"

           GOTO SINGLE

EN5       ;

 +1        SET AQASNO="R5^AQACQRI1"

           GOTO SINGLE

EN6       ;

 +1        SET AQASNO="R6^AQACQRI1"

           GOTO SINGLE

EN7       ;

 +1        SET AQASNO="R7^AQACQRI1"

           GOTO SINGLE

EN8       ;

 +1        SET AQASNO="R8^AQACQRI1"

           GOTO SINGLE

EN9       ;

 +1        SET AQASNO="R9^AQACQRI1"

           GOTO SINGLE

EN10      ;

 +1        SET AQASNO="R10^AQACQRI1"

           GOTO SINGLE

EN11      ;

 +1        SET AQASNO="R11^AQACQRI2"

           GOTO SINGLE

EN12      ;

 +1        SET AQASNO="R12^AQACQRI2"

           GOTO SINGLE

EN13      ;

 +1        SET AQASNO="R13^AQACQRI2"

           GOTO SINGLE

EN14      ;

 +1        SET AQASNO="R14^AQACQRI2"

           GOTO SINGLE

EN15      ;

 +1        SET AQASNO="R15^AQACQRI2"

           GOTO SINGLE

EN16      ;

 +1        SET AQASNO="R16^AQACQRI2"

           GOTO SINGLE

EN17      ;

 +1        SET AQASNO="R17^AQACQRI2"

           GOTO SINGLE

SINGLE     DO START1

           IF $DATA(IO("Q"))

               GOTO QUE

           IF $DATA(AQACIOP)

               GOTO PRNOW

           GOTO QUIT

QUIT       KILL %DT,DTOUT,AQACNBR,AQASNO,AQACIOP,AQASD,AQASD1,AQAFD,AQAFD1,AQAG,ZTSK

           IF $DATA(AQAZTSK)

               IF $DATA(^%ZTSK(AQAZTSK))

                   KILL ^%ZTSK(AQAZTSK),AQAZTSK

 +1        QUIT

AQACQRI.m