Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPAAR1A

ABPAAR1A.m

Go to the documentation of this file.
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
 ;
 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