ABPVRX01.m

ABPVRX01 ;QUEUE RX BILLING SUMMARY;[ 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))!(DUZ(2)<1) S DUZ(2)=$P(^AUTTSITE(1,0),"^")

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

 Q

 ;

TITLE K ABPV("HD")

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

 S ABPV("HD",2)="PHARMACY PRESCRIPTIONS BY FILL DATE" D ^ABPVHD

 W !!,"This Program will search the prescription file for all "

 W "prescriptions with",!,"fill dates within the range you specify "

 W "that were ordered for Private Insurance",!,"Eligible patients."

 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="^ABPVRX02",ZTSAVE("ABPV(")="",ZTIO=""

 S ZTDESC="COMPILE PVT INS ELIGIBLE RX'S"

 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

ABPVRX01  ;QUEUE RX BILLING SUMMARY;[ 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

 +1        IF '$DATA(DUZ(2))!(DUZ(2)<1)

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

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

 +3        QUIT 

 +4       ;

TITLE      KILL ABPV("HD")

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

 +2        SET ABPV("HD",2)="PHARMACY PRESCRIPTIONS BY FILL DATE"

           DO ^ABPVHD

 +3        WRITE !!,"This Program will search the prescription file for all "

 +4        WRITE "prescriptions with",!,"fill dates within the range you specify "

 +5        WRITE "that were ordered for Private Insurance",!,"Eligible patients."

 +6        QUIT 

 +7       ;

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="^ABPVRX02"

           SET ZTSAVE("ABPV(")=""

           SET ZTIO=""

 +1        SET ZTDESC="COMPILE PVT INS ELIGIBLE RX'S"

 +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