PSOCPIB5 ;BIR/EJW-Report of back-billed fills with insurance information ;06/24/03
;;7.0;OUTPATIENT PHARMACY;**142**;DEC 1997
;External reference to $$STATUS^IBARX supported by DBIA 125
;External reference to $$PTCOV^IBCNSU3 supported by DBIA 4115
RPT ;
W !!,"This report shows the patient name, prescription fill, and insurance"
W !,"information for fills that were billed as part of patch PSO*7*123 clean-up."
W !!,"You may queue the report to print, if you wish.",!
;
DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
QUEUE I $D(IO("Q")) S ZTRTN="START^PSOCPIB5",ZTDESC="Billed copay insurance report" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
START ;
N PSOFIRST
U IO
S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
S PSOPGCT=0,PSOPGLN=IOSL-7,PSOPGCT=1
D TITLE
S PSOJ=0
S BILLDT=$P($G(^XTMP("PSOCPIB3",0)),"^",2)
F S PSOJ=$O(^XTMP("PSOCPIB3",PSOJ)) Q:PSOJ="" S PSONAM="" F S PSONAM=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM)) Q:PSONAM="" S PSODFN="" F S PSODFN=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN)) Q:PSODFN="" D
.S PSOFIRST=1
.W !
.S RXP="" F S RXP=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP)) Q:RXP="" S PSOFILL="" F S PSOFILL=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL)) Q:PSOFILL="" D
..N XX
..S XX=$G(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL)) D
...I PSOFIRST D FULL Q:$G(PSOOUT) W !,PSONAM D PRTSSN S PSOFIRST=0
...D FULL Q:$G(PSOOUT) W !,?4,RXP," (",PSOFILL,")" D
....S Y=XX I Y>0 X ^DD("DD")
....W ?25," ",Y
....S PSORXP=$O(^PSRX("B",RXP,"")) I PSORXP="" Q
....S PSOBILL=$S('PSOFILL:$P($G(^PSRX(PSORXP,"IB")),"^",2),1:$P($G(^PSRX(PSORXP,1,PSOFILL,"IB")),"^"))
....I 'PSOBILL W ?43,"** NO BILL NUMBER FOR THIS FILL **" Q
....S PSOIBST=$$STATUS^IBARX(PSOBILL) I PSOIBST=2 W "** COPAY CHARGE CANCELLED **" Q
....W ?46,$S($$PTCOV^IBCNSU3(PSODFN,XX,"PHARMACY"):"YES",1:" NO"),?68,$S($$PTCOV^IBCNSU3(PSODFN,XX,"PHARMACY"):"YES",1:" NO")
G END
;
FULL ;
I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE
Q
;
TITLE ;
I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
;
W @IOF D
. W !,"Patch PSO*7*142 -COPAYS BILLED BY PSO*7*123 WITH RX INSURANCE INFORMATION"
S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
F MJT=1:1:79 W "="
W !,"PATIENT NAME (SSN) DIV",?44,"RX INSURANCE",?66,"RX INSURANCE"
W !,?4,"RX# (FILL)",?25,"RELEASE DATE",?43,"ON RELEASE DATE",?65,"ON BILLED DATE"
W !,"------------------------",?25,"------------",?43,"---------------",?65,"--------------"
S PSOPGCT=PSOPGCT+1
Q
END ;
I '$G(PSOOUT),$G(PSODV)="C" W !!,"** End of Report **" K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSODV)="C" W !
E W @IOF
DONE ;
K MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT,PSORXP,PSOIBST,PSOFILL,PSOOUT,PSOBILL,PSODIV,PSODFN,BILLDT,PSOJ,PSONAM,RXP,PSODV,VA
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
PRTSSN ;
N DFN
S DFN=PSODFN D PID^VADPT
S PSORXP=$O(^PSRX("B",RXP,"")) I PSORXP="" Q
S PSODIV=$P($G(^PSRX(PSORXP,2)),"^",9) S:PSODIV'="" PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1)
W " ("_$G(VA("BID"))_")"_" "_PSODIV
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPIB5 3246 printed Sep 23, 2025@20:02:15 Page 2
PSOCPIB5 ;BIR/EJW-Report of back-billed fills with insurance information ;06/24/03
+1 ;;7.0;OUTPATIENT PHARMACY;**142**;DEC 1997
+2 ;External reference to $$STATUS^IBARX supported by DBIA 125
+3 ;External reference to $$PTCOV^IBCNSU3 supported by DBIA 4115
RPT ;
+1 WRITE !!,"This report shows the patient name, prescription fill, and insurance"
+2 WRITE !,"information for fills that were billed as part of patch PSO*7*123 clean-up."
+3 WRITE !!,"You may queue the report to print, if you wish.",!
+4 ;
DVC KILL %ZIS,POP,IOP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
WRITE !!,"Nothing queued to print.",!
GOTO DONE
QUEUE IF $DATA(IO("Q"))
SET ZTRTN="START^PSOCPIB5"
SET ZTDESC="Billed copay insurance report"
DO ^%ZTLOAD
KILL %ZSI
WRITE !,"Report queued to print.",!
GOTO DONE
START ;
+1 NEW PSOFIRST
+2 USE IO
+3 SET PSOOUT=0
SET PSODV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")
+4 SET PSOPGCT=0
SET PSOPGLN=IOSL-7
SET PSOPGCT=1
+5 DO TITLE
+6 SET PSOJ=0
+7 SET BILLDT=$PIECE($GET(^XTMP("PSOCPIB3",0)),"^",2)
+8 FOR
SET PSOJ=$ORDER(^XTMP("PSOCPIB3",PSOJ))
if PSOJ=""
QUIT
SET PSONAM=""
FOR
SET PSONAM=$ORDER(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM))
if PSONAM=""
QUIT
SET PSODFN=""
FOR
SET PSODFN=$ORDER(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN))
if PSODFN=""
QUIT
Begin DoDot:1
+9 SET PSOFIRST=1
+10 WRITE !
+11 SET RXP=""
FOR
SET RXP=$ORDER(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP))
if RXP=""
QUIT
SET PSOFILL=""
FOR
SET PSOFILL=$ORDER(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:2
+12 NEW XX
+13 SET XX=$GET(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL))
Begin DoDot:3
+14 IF PSOFIRST
DO FULL
if $GET(PSOOUT)
QUIT
WRITE !,PSONAM
DO PRTSSN
SET PSOFIRST=0
+15 DO FULL
if $GET(PSOOUT)
QUIT
WRITE !,?4,RXP," (",PSOFILL,")"
Begin DoDot:4
+16 SET Y=XX
IF Y>0
XECUTE ^DD("DD")
+17 WRITE ?25," ",Y
+18 SET PSORXP=$ORDER(^PSRX("B",RXP,""))
IF PSORXP=""
QUIT
+19 SET PSOBILL=$SELECT('PSOFILL:$PIECE($GET(^PSRX(PSORXP,"IB")),"^",2),1:$PIECE($GET(^PSRX(PSORXP,1,PSOFILL,"IB")),"^"))
+20 IF 'PSOBILL
WRITE ?43,"** NO BILL NUMBER FOR THIS FILL **"
QUIT
+21 SET PSOIBST=$$STATUS^IBARX(PSOBILL)
IF PSOIBST=2
WRITE "** COPAY CHARGE CANCELLED **"
QUIT
+22 WRITE ?46,$SELECT($$PTCOV^IBCNSU3(PSODFN,XX,"PHARMACY"):"YES",1:" NO"),?68,$SELECT($$PTCOV^IBCNSU3(PSODFN,XX,"PHARMACY"):"YES",1:" NO")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 GOTO END
+24 ;
FULL ;
+1 IF ($Y+7)>IOSL&('$GET(PSOOUT))
DO TITLE
+2 QUIT
+3 ;
TITLE ;
+1 IF $GET(PSODV)="C"
IF $GET(PSOPGCT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSOOUT=1
QUIT
+2 ;
+3 WRITE @IOF
Begin DoDot:1
+4 WRITE !,"Patch PSO*7*142 -COPAYS BILLED BY PSO*7*123 WITH RX INSURANCE INFORMATION"
End DoDot:1
+5 SET Y=DT
XECUTE ^DD("DD")
WRITE !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
+6 FOR MJT=1:1:79
WRITE "="
+7 WRITE !,"PATIENT NAME (SSN) DIV",?44,"RX INSURANCE",?66,"RX INSURANCE"
+8 WRITE !,?4,"RX# (FILL)",?25,"RELEASE DATE",?43,"ON RELEASE DATE",?65,"ON BILLED DATE"
+9 WRITE !,"------------------------",?25,"------------",?43,"---------------",?65,"--------------"
+10 SET PSOPGCT=PSOPGCT+1
+11 QUIT
END ;
+1 IF '$GET(PSOOUT)
IF $GET(PSODV)="C"
WRITE !!,"** End of Report **"
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+2 IF $GET(PSODV)="C"
WRITE !
+3 IF '$TEST
WRITE @IOF
DONE ;
+1 KILL MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT,PSORXP,PSOIBST,PSOFILL,PSOOUT,PSOBILL,PSODIV,PSODFN,BILLDT,PSOJ,PSONAM,RXP,PSODV,VA
+2 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
+4 ;
PRTSSN ;
+1 NEW DFN
+2 SET DFN=PSODFN
DO PID^VADPT
+3 SET PSORXP=$ORDER(^PSRX("B",RXP,""))
IF PSORXP=""
QUIT
+4 SET PSODIV=$PIECE($GET(^PSRX(PSORXP,2)),"^",9)
if PSODIV'=""
SET PSODIV=$PIECE($GET(^PS(59,PSODIV,0)),"^",1)
+5 WRITE " ("_$GET(VA("BID"))_")"_" "_PSODIV
+6 QUIT
+7 ;
