ABPVRX03 ;PRINT RX BILLING SUMMARY; [ 06/02/91 9:44 AM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START ;
S ZTSK=ABPV("TASK"),ABPVSD=ABPV("BEG"),ABPVFD=ABPV("END")
I '$D(DT) S X="T" D ^%DT S DT=Y
S $P(ABPV80D,"-",80)="" ;80 DASHES
S Y=ABPVSD X ^DD("DD") S ABPVSDY=Y S Y=ABPVFD X ^DD("DD") S ABPVFDY=Y S Y=DT X ^DD("DD") S ABPVDTP=Y
S ABPVFEE=4.5,ABPVRXZM=0,ZFL1=""
S ABPVPG=0,ZDFNS=0
S ABPVDFN=0 F I=0:0 S ABPVDFN=$O(^%ZTSK(ZTSK,"RX",ABPVDFN)) G:ABPVDFN="" DONE D C1
C1 S ABPVHRN=$P(ABPVDFN,"."),DFN=$P(ABPVDFN,".",2)
S ABPVDPT=^DPT(DFN,0),ABPVNAME=$P(ABPVDPT,"^"),Y=$P(ABPVDPT,"^",3) X ^DD("DD")
;
D HEAD:ABPVDFN'=ZDFNS
S ZDFNS=ABPVDFN
W !!,$J(ABPVHRN,6),?8,ABPVNAME,?40,Y
SCRIP S ABPVDT="" F K=0:0 S ABPVDT=$O(^%ZTSK(ZTSK,"RX",ABPVDFN,ABPVDT)) Q:ABPVDT'=+ABPVDT D C2
D SCRIPSUM Q
C2 S ABPVPRVI=0 F J=0:0 S ABPVPRVI=$O(^AUPNPRVT(DFN,11,ABPVPRVI)) Q:ABPVPRVI'=+ABPVPRVI D PI
D:ZFL1'=ABPVDFN SUBHD
S ABPVPDFN="" F L=0:0 S ABPVPDFN=$O(^%ZTSK(ZTSK,"RX",ABPVDFN,ABPVDT,ABPVPDFN)) Q:ABPVPDFN'=+ABPVPDFN D PRNT
Q
PI Q:ZFL1=ABPVDFN S ABPVPRV=^AUPNPRVT(DFN,11,ABPVPRVI,0)
S ABPVPRVE=$P(ABPVPRV,"^",7),ABPVPRVS=$P(ABPVPRV,"^",6) I ABPVPRVE]"",ABPVPRVE<ABPVDT Q
Q:ABPVPRVS>ABPVDT
I '$D(^AUTNINS(+ABPVPRV,0)) S ZINSNM="UNKNOWN" G PI4
S ZINSNM=$P(^AUTNINS(+ABPVPRV,0),"^",1)
PI4 W !!,?8,ZINSNM,?40,$P(ABPVPRV,"^",2)
W !,?8,$P(ABPVPRV,"^",4) I $P(ABPVPRV,"^",5)]"" W ?40,$P(^AUTTRLSH($P(ABPVPRV,"^",5),0),"^")
W ! Q
SCRIPSUM ;PRINT SUM OF DRUG COST
W !,?13,"**** TOTAL DRUG COST **** = ",?42,$J(ABPVRXZM,6,2),! S ABPVRXZM=0 Q
PRNT I $Y>(IOSL-10) W @IOF D SUBHD
S ABPVN0=^PSRX(ABPVPDFN,0),ABPVDDFN=$P(ABPVN0,"^",6),ABPVQTY=$P(ABPVN0,"^",7)
S Y=ABPVDT X ^DD("DD")
W !,Y
W ?13,$P(^PSDRUG(ABPVDDFN,0),"^")
I $D(^PSDRUG(ABPVDDFN,2)) S ABPVNDC=$P(^(2),"^",4) W ?42,ABPVNDC
S ABPVDU=$S($D(^PSDRUG(ABPVDDFN,660)):$P(^(660),"^",8),1:"")
W !,?13,ABPVQTY_" "_ABPVDU
S ZUPDATE="" I $D(^PSDRUG(ABPVDDFN,9999999))=1!($D(^PSDRUG(ABPVDDFN,9999999))=11) S ZUPDATE=$P(^PSDRUG(ABPVDDFN,9999999),"^",2)
I +ZUPDATE=0 W ?56,"PRICING INFO NOT CURRENT",! G PRNTENDZ
S ABPVPPDU=$P(^PSDRUG(ABPVDDFN,660),"^",6)
I +ABPVPPDU=0 W ?56,"PRICING INFO NOT ON FILE",! G PRNTENDZ
S ABPVCST=ABPVQTY*ABPVPPDU,ABPVBILL=ABPVFEE+ABPVCST
W " at $"_$J(ABPVPPDU,6,3)_" each",?56,$J(ABPVCST,6,2),?64,$J(ABPVFEE,6,2),?72,$J(ABPVBILL,6,2),!
PRNTEND S ABPVRXZM=ABPVRXZM+ABPVBILL
PRNTENDZ S ZFL1=ABPVDFN Q
HEAD S ABPVPG=ABPVPG+1 G:ABPVPG=1 HEAD1
;
HEAD1 W @IOF
W $P(^DIC(4,ABPV("SITE"),0),"^"),?57,ABPVDTP,?70,"Page ",ABPVPG,!
W !,"Prescriptions between "_ABPVSDY_" and "_ABPVFDY_" for Prvt. Insurance Eligibles."
W !!,?2,"HRCN",?8,"Patient Name",?40,"DOB",!!,?8,"Insurer",?40,"Policy Number",!,?8,"Name of Insured",?40,"Relationship"
W !,ABPV80D
Q
SUBHD ;
W !,"Fill Date",?13,"Drug",?42,"NDC Code",?58,"Cost",?66,"Fee",?73,"Total",!,"-----------",?13,"---------------------------",?42,"------------",?58,"------",?64,"------",?72,"------"
Q
DONE W @IOF X ^%ZIS("C")
K ABPVD0D,ABPVBILL,ABPVCST,ABPVDDFN,ABPVDFN,ABPVDPT,ABPVDT,ABPVDTP,ABPVDU,ABPVFD,ABPVFDY,ABPVFEE,ABPVHRN,ABPVPRVE,ABPVPRIV,ABPVPRVS,ABPVQTY,ABPVRXZM,ABPVS,J,K,L,X,Y,ZDFNS,ZFL1,ZINSNM,ZTSK,ZUPDATE
Q
ABPVRX03 ;PRINT RX BILLING SUMMARY; [ 06/02/91 9:44 AM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START ;
+1 SET ZTSK=ABPV("TASK")
SET ABPVSD=ABPV("BEG")
SET ABPVFD=ABPV("END")
+2 IF '$DATA(DT)
SET X="T"
DO ^%DT
SET DT=Y
+3 ;80 DASHES
SET $PIECE(ABPV80D,"-",80)=""
+4 SET Y=ABPVSD
XECUTE ^DD("DD")
SET ABPVSDY=Y
SET Y=ABPVFD
XECUTE ^DD("DD")
SET ABPVFDY=Y
SET Y=DT
XECUTE ^DD("DD")
SET ABPVDTP=Y
+5 SET ABPVFEE=4.5
SET ABPVRXZM=0
SET ZFL1=""
+6 SET ABPVPG=0
SET ZDFNS=0
+7 SET ABPVDFN=0
FOR I=0:0
SET ABPVDFN=$ORDER(^%ZTSK(ZTSK,"RX",ABPVDFN))
IF ABPVDFN=""
GOTO DONE
DO C1
C1 SET ABPVHRN=$PIECE(ABPVDFN,".")
SET DFN=$PIECE(ABPVDFN,".",2)
+1 SET ABPVDPT=^DPT(DFN,0)
SET ABPVNAME=$PIECE(ABPVDPT,"^")
SET Y=$PIECE(ABPVDPT,"^",3)
XECUTE ^DD("DD")
+2 ;
+3 IF ABPVDFN'=ZDFNS
DO HEAD
+4 SET ZDFNS=ABPVDFN
+5 WRITE !!,$JUSTIFY(ABPVHRN,6),?8,ABPVNAME,?40,Y
SCRIP SET ABPVDT=""
FOR K=0:0
SET ABPVDT=$ORDER(^%ZTSK(ZTSK,"RX",ABPVDFN,ABPVDT))
IF ABPVDT'=+ABPVDT
QUIT
DO C2
+1 DO SCRIPSUM
QUIT
C2 SET ABPVPRVI=0
FOR J=0:0
SET ABPVPRVI=$ORDER(^AUPNPRVT(DFN,11,ABPVPRVI))
IF ABPVPRVI'=+ABPVPRVI
QUIT
DO PI
+1 IF ZFL1'=ABPVDFN
DO SUBHD
+2 SET ABPVPDFN=""
FOR L=0:0
SET ABPVPDFN=$ORDER(^%ZTSK(ZTSK,"RX",ABPVDFN,ABPVDT,ABPVPDFN))
IF ABPVPDFN'=+ABPVPDFN
QUIT
DO PRNT
+3 QUIT
PI IF ZFL1=ABPVDFN
QUIT
SET ABPVPRV=^AUPNPRVT(DFN,11,ABPVPRVI,0)
+1 SET ABPVPRVE=$PIECE(ABPVPRV,"^",7)
SET ABPVPRVS=$PIECE(ABPVPRV,"^",6)
IF ABPVPRVE]""
IF ABPVPRVE<ABPVDT
QUIT
+2 IF ABPVPRVS>ABPVDT
QUIT
+3 IF '$DATA(^AUTNINS(+ABPVPRV,0))
SET ZINSNM="UNKNOWN"
GOTO PI4
+4 SET ZINSNM=$PIECE(^AUTNINS(+ABPVPRV,0),"^",1)
PI4 WRITE !!,?8,ZINSNM,?40,$PIECE(ABPVPRV,"^",2)
+1 WRITE !,?8,$PIECE(ABPVPRV,"^",4)
IF $PIECE(ABPVPRV,"^",5)]""
WRITE ?40,$PIECE(^AUTTRLSH($PIECE(ABPVPRV,"^",5),0),"^")
+2 WRITE !
QUIT
SCRIPSUM ;PRINT SUM OF DRUG COST
+1 WRITE !,?13,"**** TOTAL DRUG COST **** = ",?42,$JUSTIFY(ABPVRXZM,6,2),!
SET ABPVRXZM=0
QUIT
PRNT IF $Y>(IOSL-10)
WRITE @IOF
DO SUBHD
+1 SET ABPVN0=^PSRX(ABPVPDFN,0)
SET ABPVDDFN=$PIECE(ABPVN0,"^",6)
SET ABPVQTY=$PIECE(ABPVN0,"^",7)
+2 SET Y=ABPVDT
XECUTE ^DD("DD")
+3 WRITE !,Y
+4 WRITE ?13,$PIECE(^PSDRUG(ABPVDDFN,0),"^")
+5 IF $DATA(^PSDRUG(ABPVDDFN,2))
SET ABPVNDC=$PIECE(^(2),"^",4)
WRITE ?42,ABPVNDC
+6 SET ABPVDU=$SELECT($DATA(^PSDRUG(ABPVDDFN,660)):$PIECE(^(660),"^",8),1:"")
+7 WRITE !,?13,ABPVQTY_" "_ABPVDU
+8 SET ZUPDATE=""
IF $DATA(^PSDRUG(ABPVDDFN,9999999))=1!($DATA(^PSDRUG(ABPVDDFN,9999999))=11)
SET ZUPDATE=$PIECE(^PSDRUG(ABPVDDFN,9999999),"^",2)
+9 IF +ZUPDATE=0
WRITE ?56,"PRICING INFO NOT CURRENT",!
GOTO PRNTENDZ
+10 SET ABPVPPDU=$PIECE(^PSDRUG(ABPVDDFN,660),"^",6)
+11 IF +ABPVPPDU=0
WRITE ?56,"PRICING INFO NOT ON FILE",!
GOTO PRNTENDZ
+12 SET ABPVCST=ABPVQTY*ABPVPPDU
SET ABPVBILL=ABPVFEE+ABPVCST
+13 WRITE " at $"_$JUSTIFY(ABPVPPDU,6,3)_" each",?56,$JUSTIFY(ABPVCST,6,2),?64,$JUSTIFY(ABPVFEE,6,2),?72,$JUSTIFY(ABPVBILL,6,2),!
PRNTEND SET ABPVRXZM=ABPVRXZM+ABPVBILL
PRNTENDZ SET ZFL1=ABPVDFN
QUIT
HEAD SET ABPVPG=ABPVPG+1
IF ABPVPG=1
GOTO HEAD1
+1 ;
HEAD1 WRITE @IOF
+1 WRITE $PIECE(^DIC(4,ABPV("SITE"),0),"^"),?57,ABPVDTP,?70,"Page ",ABPVPG,!
+2 WRITE !,"Prescriptions between "_ABPVSDY_" and "_ABPVFDY_" for Prvt. Insurance Eligibles."
+3 WRITE !!,?2,"HRCN",?8,"Patient Name",?40,"DOB",!!,?8,"Insurer",?40,"Policy Number",!,?8,"Name of Insured",?40,"Relationship"
+4 WRITE !,ABPV80D
+5 QUIT
SUBHD ;
+1 WRITE !,"Fill Date",?13,"Drug",?42,"NDC Code",?58,"Cost",?66,"Fee",?73,"Total",!,"-----------",?13,"---------------------------",?42,"------------",?58,"------",?64,"------",?72,"------"
+2 QUIT
DONE WRITE @IOF
XECUTE ^%ZIS("C")
+1 KILL ABPVD0D,ABPVBILL,ABPVCST,ABPVDDFN,ABPVDFN,ABPVDPT,ABPVDT,ABPVDTP,ABPVDU,ABPVFD,ABPVFDY,ABPVFEE,ABPVHRN,ABPVPRVE,ABPVPRIV,ABPVPRVS,ABPVQTY,ABPVRXZM,ABPVS,J,K,L,X,Y,ZDFNS,ZFL1,ZINSNM,ZTSK,ZUPDATE
+2 QUIT
