ABPAAR1A ;QUEUE PVT INS UTILIZATION REPORT; [ 05/24/91 12:44 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
W !!,"<<< SORRY, ACCESS DENIED!!! >>>",!! H 2 G ZTLEND
;
START D ZTLEND,INIT,HEAD
D ^ABPADATE I '$D(EDT) D ZTLEND K ABPA Q
D FAC I '$D(FAC) D ZTLEND Q
D DEVICE I $D(ABPA("IO"))'=1 D ZTLEND K ABPA Q
D ZTLOAD K ABPA S IOP=$I D ^%ZIS K IOP
Q
;
AUTO D ZTLEND S ZTDTH=$H,ABPA("IO")=+IO
S MONTH=+$E(DT,4,5) I MONTH>9 S BDT=($E(DT,1,3))_1001
I MONTH<10 S BDT=($E(DT,1,3)-1)_1001
I ABPA("RPTYP")="MTD" S BDT=$E(DT,1,5)_"01"
S EDT=DT,FAC=0,AUTO=1 D ZTLOAD K ABPA
Q
;
INIT D DT^DICRW S AUTO=0
Q
;
HEAD S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="Print AREA UTILIZATION REPORT" D ^ABPAHD W !!
Q
;
FAC W !!,"Report on ALL facilities for this period" S %=1 D YN^DICN
Q:+%<0
I +%<1 W *7,!?4,"ANSWER 'YES' OR 'NO'" G FAC
I +%=1 S FAC=0 Q
S DIC="^DIC(4,",DIC(0)="AEQ",DIC("A")="Select FACILTY NAME: "
W ! D ^DIC Q:+Y<0 S FAC=+Y
Q
;
DEVICE S %IS="NP",IOP="Q" W !! D ^%ZIS
I +IO=0 D H 3 Q
.W *7,!!?5,"<<< NO DEVICE SELECTED - JOB ABORTED >>>"
S ABPA("IO")=+IO
Q
;
ZTLOAD S ZTRTN="R0^ABPAAR1B",ZTIO=""
S ZTDESC="COMPILE PVT INS UTILIZATION REPORT"
S ZTSAVE("BDT")="",ZTSAVE("EDT")="",ZTSAVE("FAC")=""
S ZTSAVE("ABPA(")="",ZTSAVE("AUTO")="" D ^%ZTLOAD
I 'AUTO I $D(ZTSK)=1 W !!,"REQUEST QUEUED!! Task number: ",ZTSK H 3
ZTLEND K %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,FAC,ZTRTN,ZTSAVE,ZTIO,ZTDESC,MONTH
K DIC,%,IOP,I,AUTO
ABPAAR1A ;QUEUE PVT INS UTILIZATION REPORT; [ 05/24/91 12:44 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 WRITE !!,"<<< SORRY, ACCESS DENIED!!! >>>",!!
HANG 2
GOTO ZTLEND
+3 ;
START DO ZTLEND
DO INIT
DO HEAD
+1 DO ^ABPADATE
IF '$DATA(EDT)
DO ZTLEND
KILL ABPA
QUIT
+2 DO FAC
IF '$DATA(FAC)
DO ZTLEND
QUIT
+3 DO DEVICE
IF $DATA(ABPA("IO"))'=1
DO ZTLEND
KILL ABPA
QUIT
+4 DO ZTLOAD
KILL ABPA
SET IOP=$IO
DO ^%ZIS
KILL IOP
+5 QUIT
+6 ;
AUTO DO ZTLEND
SET ZTDTH=$HOROLOG
SET ABPA("IO")=+IO
+1 SET MONTH=+$EXTRACT(DT,4,5)
IF MONTH>9
SET BDT=($EXTRACT(DT,1,3))_1001
+2 IF MONTH<10
SET BDT=($EXTRACT(DT,1,3)-1)_1001
+3 IF ABPA("RPTYP")="MTD"
SET BDT=$EXTRACT(DT,1,5)_"01"
+4 SET EDT=DT
SET FAC=0
SET AUTO=1
DO ZTLOAD
KILL ABPA
+5 QUIT
+6 ;
INIT DO DT^DICRW
SET AUTO=0
+1 QUIT
+2 ;
HEAD SET ABPA("HD",1)=ABPATLE
+1 SET ABPA("HD",2)="Print AREA UTILIZATION REPORT"
DO ^ABPAHD
WRITE !!
+2 QUIT
+3 ;
FAC WRITE !!,"Report on ALL facilities for this period"
SET %=1
DO YN^DICN
+1 IF +%<0
QUIT
+2 IF +%<1
WRITE *7,!?4,"ANSWER 'YES' OR 'NO'"
GOTO FAC
+3 IF +%=1
SET FAC=0
QUIT
+4 SET DIC="^DIC(4,"
SET DIC(0)="AEQ"
SET DIC("A")="Select FACILTY NAME: "
+5 WRITE !
DO ^DIC
IF +Y<0
QUIT
SET FAC=+Y
+6 QUIT
+7 ;
DEVICE SET %IS="NP"
SET IOP="Q"
WRITE !!
DO ^%ZIS
+1 IF +IO=0
Begin DoDot:1
+2 WRITE *7,!!?5,"<<< NO DEVICE SELECTED - JOB ABORTED >>>"
End DoDot:1
HANG 3
QUIT
+3 SET ABPA("IO")=+IO
+4 QUIT
+5 ;
ZTLOAD SET ZTRTN="R0^ABPAAR1B"
SET ZTIO=""
+1 SET ZTDESC="COMPILE PVT INS UTILIZATION REPORT"
+2 SET ZTSAVE("BDT")=""
SET ZTSAVE("EDT")=""
SET ZTSAVE("FAC")=""
+3 SET ZTSAVE("ABPA(")=""
SET ZTSAVE("AUTO")=""
DO ^%ZTLOAD
+4 IF 'AUTO
IF $DATA(ZTSK)=1
WRITE !!,"REQUEST QUEUED!! Task number: ",ZTSK
HANG 3
ZTLEND KILL %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,FAC,ZTRTN,ZTSAVE,ZTIO,ZTDESC,MONTH
+1 KILL DIC,%,IOP,I,AUTO