- 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
