ABPVDG01.m

ABPVDG01 ;QUEUE PRIVATE INSURANCE ELIG I/P ADMIT REPORT; [ 06/04/91  12:45 PM ]

 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991

START D ZTLEND,INIT,TITLE

 D DATES I '$D(ABPV("BEG"))!'$D(ABPV("END")) D ZTLEND Q

 D DEVICE I $D(ABPV("IO"))'=1 D ZTLEND Q

 D ZTLOAD

 Q

 ;

INIT D DT^DICRW I $D(DUZ(2))'=1 D

 .S DUZ(2)=$P(^AUTTSITE(1,0),"^")

 S ABPV("SITE")=DUZ(2)

 S ABPV("SITENAME")=$P(^DIC(4,DUZ(2),0),"^")

 Q

 ;

TITLE K ABPV("HD")

 S ABPV("HD",1)="P R I V A T E   I N S U R A N C E   E L I G I B L E"

 S ABPV("HD",2)="IN-PATIENT ADMISSIONS REPORT" D ^ABPVHD

 Q

 ;

DATES D ^ABPVDATE

 S:$D(BDT)=1 ABPV("BEG")=BDT S:$D(EDT)=1 ABPV("END")=EDT K BDT,EDT

 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 ABPV("IO")=+IO

 Q

 ;

ZTLOAD S ZTRTN="^ABPVDG02",ZTSAVE("ABPV(")="",ZTIO=""

 S ZTDESC="COMPILE PVT INS ELIGIBLE IN-PATIENT ADMISSIONS"

 D ^%ZTLOAD I $D(ZTSK)=1 W !!,"REQUEST QUEUED!!  Task number: ",ZTSK

 H 3

ZTLEND K ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,R,I

 S IOP=$I D ^%ZIS K IOP

 Q

ABPVDG01  ;QUEUE PRIVATE INSURANCE ELIG I/P ADMIT REPORT; [ 06/04/91  12:45 PM ]

 +1       ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991

START      DO ZTLEND

           DO INIT

           DO TITLE

 +1        DO DATES

           IF '$DATA(ABPV("BEG"))!'$DATA(ABPV("END"))

               DO ZTLEND

               QUIT 

 +2        DO DEVICE

           IF $DATA(ABPV("IO"))'=1

               DO ZTLEND

               QUIT 

 +3        DO ZTLOAD

 +4        QUIT 

 +5       ;

INIT       DO DT^DICRW

           IF $DATA(DUZ(2))'=1

               Begin DoDot:1

 +1                SET DUZ(2)=$PIECE(^AUTTSITE(1,0),"^")

               End DoDot:1

 +2        SET ABPV("SITE")=DUZ(2)

 +3        SET ABPV("SITENAME")=$PIECE(^DIC(4,DUZ(2),0),"^")

 +4        QUIT 

 +5       ;

TITLE      KILL ABPV("HD")

 +1        SET ABPV("HD",1)="P R I V A T E   I N S U R A N C E   E L I G I B L E"

 +2        SET ABPV("HD",2)="IN-PATIENT ADMISSIONS REPORT"

           DO ^ABPVHD

 +3        QUIT 

 +4       ;

DATES      DO ^ABPVDATE

 +1        IF $DATA(BDT)=1

               SET ABPV("BEG")=BDT

           IF $DATA(EDT)=1

               SET ABPV("END")=EDT

           KILL BDT,EDT

 +2        QUIT 

 +3       ;

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 ABPV("IO")=+IO

 +4        QUIT 

 +5       ;

ZTLOAD     SET ZTRTN="^ABPVDG02"

           SET ZTSAVE("ABPV(")=""

           SET ZTIO=""

 +1        SET ZTDESC="COMPILE PVT INS ELIGIBLE IN-PATIENT ADMISSIONS"

 +2        DO ^%ZTLOAD

           IF $DATA(ZTSK)=1

               WRITE !!,"REQUEST QUEUED!!  Task number: ",ZTSK

 +3        HANG 3

ZTLEND     KILL ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,R,I

 +1        SET IOP=$IO

           DO ^%ZIS

           KILL IOP

 +2        QUIT