- 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
