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")
Q
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
Q
;
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
Q
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
