ABPAADR0.m

ABPAADR0 ;QUEUE PVT-INS DISTRIBUTION REPORT; [ 05/24/91  12:35 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 DISTRIBUTION 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^ABPAADR1",ZTIO=""

 S ZTDESC="COMPILE PVT INS DISTRIBUTION 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

ABPAADR0  ;QUEUE PVT-INS DISTRIBUTION REPORT; [ 05/24/91  12:35 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 DISTRIBUTION 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^ABPAADR1"

           SET ZTIO=""

 +1        SET ZTDESC="COMPILE PVT INS DISTRIBUTION 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