Routine: AZQ2RXP

AZQ2RXP ;IHS/ASU/RPL;SEARCH PRESCRIPTION FILE BY FILL DATE RANGE AND PVT INS. ELIGIBLE;8/18/89 ; 8/22/89  10:25 AM

 ;Version 1.1

START ;

 W !!,"This Option will search the prescription file for all prescriptions with",!,"fill dates within the range you specify that were ordered for Private Insurance",!,"Eligible patients.",!!

SD S %DT("A")="Starting Fill Date: ",%DT="AEPX" D ^%DT

 G:Y=-1 QUIT S AZQ2SD=Y

W !

ED S %DT("A")="Ending Fill Date: " D ^%DT

 G:Y=-1 SD S AZQ2FD=Y

 I AZQ2FD<AZQ2SD W !,"Ending Date cannot be before Starting Date! Please redo.",! G SD

ZIS W !! S %IS="Q" D ^%ZIS G:POP QUIT I '$D(IO("Q")) U IO G DQUE

QUE K IO("Q"),IO("S") I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS

 S ZTRTN="DQUE^AZQ2RXP",ZTDESC="PRESCRIPTION FILE SEARCH BY DATE AND PRIV INS EL" F AZQ2="ZTRTN","ZTDESC","AZQ2SD","AZQ2FD" S ZTSAVE(AZQ2)=""

 D ^%ZTLOAD G QUIT

DQUE ;Entry point from Taskmanager

 K ^UTILITY($J)

 S AZQ2S=AZQ2SD-.0001 F I=0:0 S AZQ2S=$O(^PSRX("AD",AZQ2S)) G PRINT:AZQ2S=""!(AZQ2S>AZQ2FD) D C1

 G QUIT2

C1 S AZQ2PDFN="" F J=0:0 S AZQ2PDFN=$O(^PSRX("AD",AZQ2S,AZQ2PDFN)) Q:AZQ2PDFN=""  D C2

C2 Q:'$D(^PSRX(AZQ2PDFN,0))

 S DFN=$P(^PSRX(AZQ2PDFN,0),"^",2) Q:DFN']""

 Q:'$D(^AUPNPRVT(DFN,11))

 S AZQ2DRG=$P(^PSRX(AZQ2PDFN,0),"^",6) Q:AZQ2DRG']""  Q:'$D(^PSDRUG(AZQ2DRG,0))  Q:$P(^(0),"^",3)["9"

 S AZQ2PRVI=0 F K=0:0 S AZQ2PRVI=$O(^AUPNPRVT(DFN,11,AZQ2PRVI)) Q:AZQ2PRVI'=+AZQ2PRVI  D C3

C3 S AZQ2PRV=^AUPNPRVT(DFN,11,AZQ2PRVI,0)

 S AZQ2PRVE=$P(AZQ2PRV,"^",7),AZQ2PRVS=$P(AZQ2PRV,"^",6) I AZQ2PRVE]"",AZQ2PRVE<AZQ2S Q

 Q:AZQ2PRVS>AZQ2S

 S AZQ2HRN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),"^",2),1:"No HRN")

 S AZQ2HRN=$J(AZQ2HRN,6)

 S ^UTILITY($J,AZQ2HRN_"."_DFN,AZQ2S,AZQ2PDFN)=""

PRINT D ^AZQ2RXP1

QUIT2 W @IOF K ^UTILITY($J) I $D(ZTSK) K ^%ZTSK(ZTSK)

QUIT X ^%ZIS("C") K AZQ2PRVE,AZQ2PRVS,AZQ2PRVI,AZQ2PRV,AZQ2,AZQ2S,AZQ2SD,AZQ2FD,DIC,%DT,^UTILITY($J),ZTSK,IO("Q"),IO("S")

 K AZQ2CST,AZQ2DFN,AZQ2DPT,AZQ2DU,AZQ2NAME,AZQ2NDC,AZQ2BILL,AZQ2DRG,AZQ2PPDU,AZQ2QTY,AZQ2QUIT,AZQ280D,AZQ2DDFN,AZQ2DT,AZQ2FDY,AZQ2HRN,AZQ2N0,AZQ2PDFN,AZQ2PG,AZQ2PRVY,AZQ2SDY,AZQ2SIG,DFN,Y,ZTRTN,ZTDESC,ZTSAVE,AZQ2DTP

AZQ2RXP   ;IHS/ASU/RPL;SEARCH PRESCRIPTION FILE BY FILL DATE RANGE AND PVT INS. ELIGIBLE;8/18/89 ; 8/22/89  10:25 AM

 +1       ;Version 1.1

START     ;

 +1        WRITE !!,"This Option will search the prescription file for all prescriptions with",!,"fill dates within the range you specify that were ordered for Private Insurance",!,"Eligible patients.",!!

SD         SET %DT("A")="Starting Fill Date: "

           SET %DT="AEPX"

           DO ^%DT

 +1        IF Y=-1

               GOTO QUIT

           SET AZQ2SD=Y

 +2        WRITE !

ED         SET %DT("A")="Ending Fill Date: "

           DO ^%DT

 +1        IF Y=-1

               GOTO SD

           SET AZQ2FD=Y

 +2        IF AZQ2FD<AZQ2SD

               WRITE !,"Ending Date cannot be before Starting Date! Please redo.",!

               GOTO SD

ZIS        WRITE !!

           SET %IS="Q"

           DO ^%ZIS

           IF POP

               GOTO QUIT

           IF '$DATA(IO("Q"))

               USE IO

               GOTO DQUE

QUE        KILL IO("Q"),IO("S")

           IF IO=IO(0)

               WRITE !,"Cannot Queue to Screen or Slave Printer!",!

               GOTO ZIS

 +1        SET ZTRTN="DQUE^AZQ2RXP"

           SET ZTDESC="PRESCRIPTION FILE SEARCH BY DATE AND PRIV INS EL"

           FOR AZQ2="ZTRTN","ZTDESC","AZQ2SD","AZQ2FD"

               SET ZTSAVE(AZQ2)=""

 +2        DO ^%ZTLOAD

           GOTO QUIT

DQUE      ;Entry point from Taskmanager

 +1        KILL ^UTILITY($JOB)

 +2        SET AZQ2S=AZQ2SD-.0001

           FOR I=0:0

               SET AZQ2S=$ORDER(^PSRX("AD",AZQ2S))

               IF AZQ2S=""!(AZQ2S>AZQ2FD)

                   GOTO PRINT

               DO C1

 +3        GOTO QUIT2

C1         SET AZQ2PDFN=""

           FOR J=0:0

               SET AZQ2PDFN=$ORDER(^PSRX("AD",AZQ2S,AZQ2PDFN))

               IF AZQ2PDFN=""

                   QUIT

               DO C2

 +1        QUIT

C2         IF '$DATA(^PSRX(AZQ2PDFN,0))

               QUIT

 +1        SET DFN=$PIECE(^PSRX(AZQ2PDFN,0),"^",2)

           IF DFN']""

               QUIT

 +2        IF '$DATA(^AUPNPRVT(DFN,11))

               QUIT

 +3        SET AZQ2DRG=$PIECE(^PSRX(AZQ2PDFN,0),"^",6)

           IF AZQ2DRG']""

               QUIT

           IF '$DATA(^PSDRUG(AZQ2DRG,0))

               QUIT

           IF $PIECE(^(0),"^",3)["9"

               QUIT

 +4        SET AZQ2PRVI=0

           FOR K=0:0

               SET AZQ2PRVI=$ORDER(^AUPNPRVT(DFN,11,AZQ2PRVI))

               IF AZQ2PRVI'=+AZQ2PRVI

                   QUIT

               DO C3

 +5        QUIT

C3         SET AZQ2PRV=^AUPNPRVT(DFN,11,AZQ2PRVI,0)

 +1        SET AZQ2PRVE=$PIECE(AZQ2PRV,"^",7)

           SET AZQ2PRVS=$PIECE(AZQ2PRV,"^",6)

           IF AZQ2PRVE]""

               IF AZQ2PRVE<AZQ2S

                   QUIT

 +2        IF AZQ2PRVS>AZQ2S

               QUIT

 +3        SET AZQ2HRN=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),"^",2),1:"No HRN")

 +4        SET AZQ2HRN=$JUSTIFY(AZQ2HRN,6)

 +5        SET ^UTILITY($JOB,AZQ2HRN_"."_DFN,AZQ2S,AZQ2PDFN)=""

 +6        QUIT

PRINT      DO ^AZQ2RXP1

QUIT2      WRITE @IOF

           KILL ^UTILITY($JOB)

           IF $DATA(ZTSK)

               KILL ^%ZTSK(ZTSK)

QUIT       XECUTE ^%ZIS("C")

           KILL AZQ2PRVE,AZQ2PRVS,AZQ2PRVI,AZQ2PRV,AZQ2,AZQ2S,AZQ2SD,AZQ2FD,DIC,%DT,^UTILITY($JOB),ZTSK,IO("Q"),IO("S")

 +1        KILL AZQ2CST,AZQ2DFN,AZQ2DPT,AZQ2DU,AZQ2NAME,AZQ2NDC,AZQ2BILL,AZQ2DRG,AZQ2PPDU,AZQ2QTY,AZQ2QUIT,AZQ280D,AZQ2DDFN,AZQ2DT,AZQ2FDY,AZQ2HRN,AZQ2N0,AZQ2PDFN,AZQ2PG,AZQ2PRVY,AZQ2SDY,AZQ2SIG,DFN,Y,ZTRTN,ZTDESC,ZTSAVE,AZQ2DTP

AZQ2RXP.m