- 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
- ;
- 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 ;
