ABPVRX02.m

ABPVRX02 ;EXTRACT RX VISITS FOR RX BILLING SUMMARY;[ 06/02/91  9:38 AM ]

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

START D INIT,XTRACT,ZTLOAD

 Q

 ;

INIT S ABPVSD=ABPV("BEG"),ABPVFD=ABPV("END"),ABPV("TASK")=ZTSK Q

 ;

XTRACT S ABPVS=ABPVSD-.0001 F I=0:0 S ABPVS=$O(^PSRX("AD",ABPVS)) Q:+ABPVS=0!(ABPVS>ABPVFD)  D C1

 Q

 ;

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

 Q

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

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

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

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

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

 Q

C3 S ABPVPRV=^AUPNPRVT(DFN,11,ABPVPRVI,0)

 S ABPVPRVE=$P(ABPVPRV,"^",7),ABPVPRVS=$P(ABPVPRV,"^",6) I ABPVPRVE]"",ABPVPRVE<ABPVS Q

 Q:ABPVPRVS>ABPVS

 S ABPVHRN=$S($D(^AUPNPAT(DFN,41,ABPV("SITE"),0)):$P(^(0),"^",2),1:"No HRN")

 S ^%ZTSK(ZTSK,"RX",ABPVHRN_"."_DFN,ABPVS,ABPVPDFN)=""

 Q

 ;

ZTLOAD S ZTRTN="^ABPVRX03",ZTDTH=$H,ZTIO=ABPV("IO"),ZTSAVE("ABPV(")=""

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

 D ^%ZTLOAD

ZTLEND K ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,A,X,Y,DIC,DIE,DA

 K DR,ZTIO,R,I,ABPVSD,ABPVFD,ABPVS,ABPVPDFN,ABPVDRG,ABPVPRVI,ABPVPRV

 K ABPVPRVE,ABPVHRN,DFN,K,ABPVPRVS

 Q

ABPVRX02  ;EXTRACT RX VISITS FOR RX BILLING SUMMARY;[ 06/02/91  9:38 AM ]

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

START      DO INIT

           DO XTRACT

           DO ZTLOAD

 +1        QUIT 

 +2       ;

INIT       SET ABPVSD=ABPV("BEG")

           SET ABPVFD=ABPV("END")

           SET ABPV("TASK")=ZTSK

           QUIT 

 +1       ;

XTRACT     SET ABPVS=ABPVSD-.0001

           FOR I=0:0

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

               IF +ABPVS=0!(ABPVS>ABPVFD)

                   QUIT 

               DO C1

 +1        QUIT 

 +2       ;

C1         SET ABPVPDFN=""

           FOR J=0:0

               SET ABPVPDFN=$ORDER(^PSRX("AD",ABPVS,ABPVPDFN))

               IF ABPVPDFN=""

                   QUIT 

               DO C2

 +1        QUIT 

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

               QUIT 

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

           IF DFN']""

               QUIT 

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

               QUIT 

 +3        SET ABPVDRG=$PIECE(^PSRX(ABPVPDFN,0),"^",6)

           IF ABPVDRG']""

               QUIT 

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

               QUIT 

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

               QUIT 

 +4        SET ABPVPRVI=0

           FOR K=0:0

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

               IF ABPVPRVI'=+ABPVPRVI

                   QUIT 

               DO C3

 +5        QUIT 

C3         SET ABPVPRV=^AUPNPRVT(DFN,11,ABPVPRVI,0)

 +1        SET ABPVPRVE=$PIECE(ABPVPRV,"^",7)

           SET ABPVPRVS=$PIECE(ABPVPRV,"^",6)

           IF ABPVPRVE]""

               IF ABPVPRVE<ABPVS

                   QUIT 

 +2        IF ABPVPRVS>ABPVS

               QUIT 

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

 +4        SET ^%ZTSK(ZTSK,"RX",ABPVHRN_"."_DFN,ABPVS,ABPVPDFN)=""

 +5        QUIT 

 +6       ;

ZTLOAD     SET ZTRTN="^ABPVRX03"

           SET ZTDTH=$HOROLOG

           SET ZTIO=ABPV("IO")

           SET ZTSAVE("ABPV(")=""

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

 +2        DO ^%ZTLOAD

ZTLEND     KILL ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,A,X,Y,DIC,DIE,DA

 +1        KILL DR,ZTIO,R,I,ABPVSD,ABPVFD,ABPVS,ABPVPDFN,ABPVDRG,ABPVPRVI,ABPVPRV

 +2        KILL ABPVPRVE,ABPVHRN,DFN,K,ABPVPRVS

 +3        QUIT