PSOCPIB3 ;BIR/EJW-Clean up to bill unbilled NON-SERVICE CONNECTED copays ;12/12/02
;;7.0;OUTPATIENT PHARMACY;**123**;DEC 1997
;External reference to ^XUSEC supported by DBIA 10076
;External reference to ^IBAM(354.7 supported by DBIA 3877
S ZTDTH=""
I $D(ZTQUEUED) S ZTDTH=$H
L +^XTMP("PSOCPIB3"):0 I '$T D Q
. I ZTDTH="" D BMES^XPDUTL("Clean up job is already running. Halting...")
L -^XTMP("PSOCPIB3")
I ZTDTH="" D
.D BMES^XPDUTL("Clean up for unbilled, released NON-SERVICE CONNECTED prescription fills.")
.D BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be ")
.D MES^XPDUTL("queued to run NOW.")
.D GETDATE
.D BMES^XPDUTL("Queuing background job to reprocess unbilled NON-SERVICE CONNECTED fills...")
S ZTRTN="EN^PSOCPIB3",ZTIO="",ZTDESC="Background job to reprocess NON-SERVICE CONNECTED unbilled copays" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
Q
EN ;
L +^XTMP("PSOCPIB3"):0 I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
N PSODT,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND
S PSOCNT=0
D NOW^%DTC S Y=% D DD^%DT S PSOSTART=Y
I '$G(DT) S DT=$$DT^XLFDT
I '$D(^XTMP("PSOCPIB3")) S X1=DT,X2=+90 D C^%DTC S ^XTMP("PSOCPIB3",0)=$G(X)_"^"_DT
I $D(^XTMP("PSOCPBAK")) G PROCESS ; POTENTIALLY BILLABLE FILLS ALREADY IDENTIFIED
S PSODT=3020203.235959 ; START WITH DATE $7 COPAY WENT INTO EFFECT
F S PSODT=$O(^PSRX("AL",PSODT)) Q:'PSODT S RXP="" F S RXP=$O(^PSRX("AL",PSODT,RXP)) Q:'RXP D
.S PSODFN=$P($G(^PSRX(RXP,0)),"^",2) Q:PSODFN="" I '$D(^DPT(PSODFN,0)) Q
.I $G(^XTMP("PSOCPBAK",$J,PSODFN)) Q ; EXEMPT OR SC QUESTION APPLIES-- NOTHING TO REPROCESS FOR THIS PATIENT
.S BADDT=$G(^XTMP("PSOCPBAK",$J,PSODFN,RXP))
.I 'BADDT D CHKLOG^PSOCPBAK
.I BADDT,BADDT'>$P(PSODT,".") D
..I '$D(^XTMP("PSOCPBAK",$J,PSODFN)) D XTYPE^PSOCPBAK S ^XTMP("PSOCPBAK",$J,PSODFN)=$S(PSOSCMX=1:"",1:1) I PSOSCMX'=1 Q ; QUIT IF SC QUESTION APPLIES -- NOTHING TO REPROCESS
..S YY="" F S YY=$O(^PSRX("AL",PSODT,RXP,YY)) Q:YY="" D
...S PSOREL=$S(YY=0:$P(^PSRX(RXP,2),"^",13),1:$P($G(^PSRX(RXP,1,YY,0)),"^",18)) I 'PSOREL Q ; RELEASED DATE WON'T BE PRESENT IF RETURNED TO STOCK
...I 'YY I $P($G(^PSRX(RXP,"IB")),"^",2)'="" Q ; ALREADY BILLED
...I 'YY I $P($G(^PSRX(RXP,"IB")),"^",4)'="" Q ; ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
...I YY,$P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" Q ; REFILL ALREADY BILLED
...I YY,$P($G(^PSRX(RXP,1,YY,"IB")),"^",2)'="" Q ; REFILL ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
...S PSOXIN=$$RXST^IBARXEU(PSODFN,$P(PSOREL,".")) I $P($G(PSOXIN),"^")=1 Q ; INCOME EXEMPT ON RELEASE DATE
...I '$D(^XTMP("PSOCPBAK",$J,PSODFN,RXP)) S ^XTMP("PSOCPBAK",$J,PSODFN,RXP)=BADDT
...S ^XTMP("PSOCPBAK",$J,PSODFN,RXP,YY)=$P(PSOREL,".") ; SAVE TO PROCESS IN "BILL" SECTION
PROCESS ;
S PSOJ=0 F S PSOJ=$O(^XTMP("PSOCPBAK",PSOJ)) Q:'PSOJ D BILL
D MAIL
D MAIL2
L -^XTMP("PSOCPIB3")
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
MAIL ;
D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
I $G(DUZ) S XMY(DUZ)=""
S XMDUZ="Outpatient Pharmacy",XMSUB="Outpatient Pharmacy Copay Clean-up"
F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
I $O(XMY(""))="" Q ; no recipients for mail message
S PSOTEXT(1)="The Rx copay clean up job for the Outpatient Pharmacy patch (PSO*7*123)"
S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
I PSOCNT>0 S PSOTEXT(3)="Released non-service connected prescriptions have now been reprocessed."
I PSOCNT>0 S PSOTEXT(4)="There were "_PSOCNT_" fills successfully billed." D
.S PSOTEXT(5)=" "
.S PSOTEXT(6)="To get a report of patient names/prescriptions that were billed as part of this"
.S PSOTEXT(7)="clean-up, enter D RPT^PSOCPIB3 at the programmer's prompt."
I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay fills were found to reprocess."
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
;
MAIL2 ; SEND NAME INFO FOR USE BY AAC
K XMY,PSOTEXT
S PSOCNT=0
S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
S XMY(DUZ)=""
S XMY("WHITE.ELAINE@DOMAIN.NAME")=""
S XMY("CARROLL.DAN@DOMAIN.NAME")=""
S XMDUZ="PSO*7*123",XMSUB=$G(PSOINST)_" - AAC DATA"
S PSONAM="" F S PSONAM=$O(^XTMP("PSOCPIB3",$J,"BILLED",PSONAM)) Q:PSONAM="" S PSODFN="" F S PSODFN=$O(^XTMP("PSOCPIB3",$J,"BILLED",PSONAM,PSODFN)) Q:PSODFN="" D
.S DFN=PSODFN D DEM^VADPT
.S PSOCNT=PSOCNT+1,PSOTEXT(PSOCNT)=PSOINST_"^"_$G(VA("BID"))_$E($P(PSONAM,","),1,5)
I '$D(PSOTEXT) S PSOTEXT(1)="NO BILLED FILLS FOR INSTITUTION: "_PSOINST
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
;
BILL ;
; IF NO IB NUMBER FOR THIS FILL, SET UP VARIABLES AND CALL CP^PSOCP. IF THERE IS AN IB NUMBER AFTER THIS CALL, COUNT IT FOR SUMMARY MAIL MSG
S PSODFN="" F S PSODFN=$O(^XTMP("PSOCPBAK",PSOJ,PSODFN)) Q:'PSODFN D
.I $G(^XTMP("PSOCPBAK",PSOJ,PSODFN)) Q ; EXEMPT OR SC QUESTION APPLIES
.S PSOCAP(302)=0
.S PSOCAP(303)=0
.S RXP="" F S RXP=$O(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP)) Q:'RXP S YY="" F S YY=$O(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP,YY)) Q:YY="" D
..S PSOREL=$G(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP,YY))
..S PSOCPUN=$P(($P(^PSRX(RXP,0),"^",8)+29)/30,".",1) ; NUMBER OF 30-DAY UNITS ELIGIBLE TO BILL
..S PSOSVUN=PSOCPUN
..D CHKTOT
..I PSOCAP($E(PSOREL,1,3)) Q ; ANNUAL CAP MET
..I 'YY D Q
...I $P($G(^PSRX(RXP,"IB")),"^",2)'="" Q ; ALREADY BILLED
...D SITE^PSOCPBA2
...D CP^PSOCP
...S PSOBILL=$P($G(^PSRX(RXP,"IB")),"^",2) I PSOBILL'="" D
....S PSONAM=$P($G(^DPT(PSODFN,0)),"^") I PSONAM="" S PSONAM="UNKNOWN"
....S PSORXP=$P($G(^PSRX(RXP,0)),"^") I PSORXP="" Q
....S PSOCNT=PSOCNT+1
....S ^XTMP("PSOCPIB3",$J,"BILLED",PSONAM,PSODFN,PSORXP,YY)=$P(PSOREL,".")
....D ACCUM
..I $P($G(^PSRX(RXP,1,YY,"IB")),"^",1)="" D ; REFILL LEVEL
...D SITE^PSOCPBA2
...D CP^PSOCP
...S PSOBILL=$P($G(^PSRX(RXP,1,YY,"IB")),"^",1) I PSOBILL'="" D
....S PSONAM=$P($G(^DPT(PSODFN,0)),"^") I PSONAM="" S PSONAM="UNKNOWN"
....S PSORXP=$P($G(^PSRX(RXP,0)),"^") I PSORXP="" Q
....S PSOCNT=PSOCNT+1
....S ^XTMP("PSOCPIB3",$J,"BILLED",PSONAM,PSODFN,PSORXP,YY)=$P(PSOREL,".")
....D ACCUM
Q
;
GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
S PSOQUES="Queue copay clean-up Job to run Date@Time: "
D GETDATE^PSOCPIB4
Q
;
RPT ;
L +^XTMP("PSOCPIB3"):0 I '$T D Q
. W !,"Clean up job for PSO*7*123 is still running. Halting..."
L -^XTMP("PSOCPIB3")
W !!,"This report shows the patient name and prescription information for fills"
W !,"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^PSOCPIB3",ZTDESC="Billed copay report" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
START ;
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
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
.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
...D FULL Q:$G(PSOOUT) W !,PSONAM D PRTSSN
...W ?39," ",RXP," (",PSOFILL,")" D
....S Y=XX I Y>0 X ^DD("DD")
....W ?65," ",Y
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*123 -COPAY PRESCRIPTION FILLS BILLED"
S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
F MJT=1:1:79 W "="
W !,"PATIENT NAME (SSN) DIV",?40,"RX# (FILL)",?66,"RELEASE DATE"
W !,"------------------------",?40,"----------",?66,"------------"
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
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
;
ACCUM ; ACCUMULATE TOTALS AND SEE IF PATIENT MET ANNUAL CAP
S PSOYR=$E(PSOREL,1,3)
S PSOCPUN=PSOSVUN
I PSOYR'=302,PSOYR'=303 Q
S PSOTOT=$G(^XTMP("PSOCPIB3",$J,PSODFN,PSOYR))
S ^XTMP("PSOCPIB3",$J,PSODFN,PSOYR)=PSOTOT+(PSOCPUN*7)
Q
;
CHKTOT ; SEE IF BILLING THIS FILL WOULD GO OVER CAP
S PSOYR=$E(PSOREL,1,3)
I PSOYR'=302,PSOYR'=303 Q
S PSOTOT=$G(^XTMP("PSOCPIB3",$J,PSODFN,PSOYR))
I 'PSOTOT D S ^XTMP("PSOCPIB3",$J,PSODFN,PSOYR)=PSOTOT
.S PSOSQ=0 F S PSOSQ=$O(^IBAM(354.7,PSODFN,1,PSOSQ)) Q:'PSOSQ S PSOLOG=$G(^IBAM(354.7,PSODFN,1,PSOSQ,0)) I $E(PSOLOG,1,3)=PSOYR D
..I $E(PSOLOG,1,5)="30201" Q ; DON'T LOOK AT JANUARY 2002 TOTALS
..S PSOTOT=PSOTOT+$P(PSOLOG,"^",2)
I PSOYR=302,PSOTOT+(7*PSOCPUN)>770 S PSOCAP(PSOYR)=1 Q ; BILLING FOR THIS WOULD EXCEED ANNUAL CAP
I PSOYR=303,PSOTOT+(7*PSOCPUN)>840 S PSOCAP(PSOYR)=1 Q ; BILLING FOR THIS WOULD EXCEED ANNUAL CAP
Q
;
PSOCPIB3 ;BIR/EJW-Clean up to bill unbilled NON-SERVICE CONNECTED copays ;12/12/02
+1 ;;7.0;OUTPATIENT PHARMACY;**123**;DEC 1997
+2 ;External reference to ^XUSEC supported by DBIA 10076
+3 ;External reference to ^IBAM(354.7 supported by DBIA 3877
+4 SET ZTDTH=""
+5 IF $DATA(ZTQUEUED)
SET ZTDTH=$HOROLOG
+6 LOCK +^XTMP("PSOCPIB3"):0
IF '$TEST
Begin DoDot:1
+7 IF ZTDTH=""
DO BMES^XPDUTL("Clean up job is already running. Halting...")
End DoDot:1
QUIT
+8 LOCK -^XTMP("PSOCPIB3")
+9 IF ZTDTH=""
Begin DoDot:1
+10 DO BMES^XPDUTL("Clean up for unbilled, released NON-SERVICE CONNECTED prescription fills.")
+11 DO BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be ")
+12 DO MES^XPDUTL("queued to run NOW.")
+13 DO GETDATE
+14 DO BMES^XPDUTL("Queuing background job to reprocess unbilled NON-SERVICE CONNECTED fills...")
End DoDot:1
+15 SET ZTRTN="EN^PSOCPIB3"
SET ZTIO=""
SET ZTDESC="Background job to reprocess NON-SERVICE CONNECTED unbilled copays"
DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+16 IF $DATA(ZTSK)&('$DATA(ZTQUEUED))
WRITE !!,"Task Queued !",!
+17 QUIT
EN ;
+1 LOCK +^XTMP("PSOCPIB3"):0
IF '$TEST
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 NEW PSODT,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND
+3 SET PSOCNT=0
+4 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOSTART=Y
+5 IF '$GET(DT)
SET DT=$$DT^XLFDT
+6 IF '$DATA(^XTMP("PSOCPIB3"))
SET X1=DT
SET X2=+90
DO C^%DTC
SET ^XTMP("PSOCPIB3",0)=$GET(X)_"^"_DT
+7 ; POTENTIALLY BILLABLE FILLS ALREADY IDENTIFIED
IF $DATA(^XTMP("PSOCPBAK"))
GOTO PROCESS
+8 ; START WITH DATE $7 COPAY WENT INTO EFFECT
SET PSODT=3020203.235959
+9 FOR
SET PSODT=$ORDER(^PSRX("AL",PSODT))
IF 'PSODT
QUIT
SET RXP=""
FOR
SET RXP=$ORDER(^PSRX("AL",PSODT,RXP))
IF 'RXP
QUIT
Begin DoDot:1
+10 SET PSODFN=$PIECE($GET(^PSRX(RXP,0)),"^",2)
IF PSODFN=""
QUIT
IF '$DATA(^DPT(PSODFN,0))
QUIT
+11 ; EXEMPT OR SC QUESTION APPLIES-- NOTHING TO REPROCESS FOR THIS PATIENT
IF $GET(^XTMP("PSOCPBAK",$JOB,PSODFN))
QUIT
+12 SET BADDT=$GET(^XTMP("PSOCPBAK",$JOB,PSODFN,RXP))
+13 IF 'BADDT
DO CHKLOG^PSOCPBAK
+14 IF BADDT
IF BADDT'>$PIECE(PSODT,".")
Begin DoDot:2
+15 ; QUIT IF SC QUESTION APPLIES -- NOTHING TO REPROCESS
IF '$DATA(^XTMP("PSOCPBAK",$JOB,PSODFN))
DO XTYPE^PSOCPBAK
SET ^XTMP("PSOCPBAK",$JOB,PSODFN)=$SELECT(PSOSCMX=1:"",1:1)
IF PSOSCMX'=1
QUIT
+16 SET YY=""
FOR
SET YY=$ORDER(^PSRX("AL",PSODT,RXP,YY))
IF YY=""
QUIT
Begin DoDot:3
+17 ; RELEASED DATE WON'T BE PRESENT IF RETURNED TO STOCK
SET PSOREL=$SELECT(YY=0:$PIECE(^PSRX(RXP,2),"^",13),1:$PIECE($GET(^PSRX(RXP,1,YY,0)),"^",18))
IF 'PSOREL
QUIT
+18 ; ALREADY BILLED
IF 'YY
IF $PIECE($GET(^PSRX(RXP,"IB")),"^",2)'=""
QUIT
+19 ; ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
IF 'YY
IF $PIECE($GET(^PSRX(RXP,"IB")),"^",4)'=""
QUIT
+20 ; REFILL ALREADY BILLED
IF YY
IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",1)'=""
QUIT
+21 ; REFILL ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
IF YY
IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",2)'=""
QUIT
+22 ; INCOME EXEMPT ON RELEASE DATE
SET PSOXIN=$$RXST^IBARXEU(PSODFN,$PIECE(PSOREL,"."))
IF $PIECE($GET(PSOXIN),"^")=1
QUIT
+23 IF '$DATA(^XTMP("PSOCPBAK",$JOB,PSODFN,RXP))
SET ^XTMP("PSOCPBAK",$JOB,PSODFN,RXP)=BADDT
+24 ; SAVE TO PROCESS IN "BILL" SECTION
SET ^XTMP("PSOCPBAK",$JOB,PSODFN,RXP,YY)=$PIECE(PSOREL,".")
End DoDot:3
End DoDot:2
End DoDot:1
PROCESS ;
+1 SET PSOJ=0
FOR
SET PSOJ=$ORDER(^XTMP("PSOCPBAK",PSOJ))
IF 'PSOJ
QUIT
DO BILL
+2 DO MAIL
+3 DO MAIL2
+4 LOCK -^XTMP("PSOCPIB3")
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
+7 ;
MAIL ;
+1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOEND=Y
+2 IF $GET(DUZ)
SET XMY(DUZ)=""
+3 SET XMDUZ="Outpatient Pharmacy"
SET XMSUB="Outpatient Pharmacy Copay Clean-up"
+4 FOR PSOCXPDA=0:0
SET PSOCXPDA=$ORDER(^XUSEC("PSO COPAY",PSOCXPDA))
IF 'PSOCXPDA
QUIT
SET XMY(PSOCXPDA)=""
+5 ; no recipients for mail message
IF $ORDER(XMY(""))=""
QUIT
+6 SET PSOTEXT(1)="The Rx copay clean up job for the Outpatient Pharmacy patch (PSO*7*123)"
+7 SET PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
+8 IF PSOCNT>0
SET PSOTEXT(3)="Released non-service connected prescriptions have now been reprocessed."
+9 IF PSOCNT>0
SET PSOTEXT(4)="There were "_PSOCNT_" fills successfully billed."
Begin DoDot:1
+10 SET PSOTEXT(5)=" "
+11 SET PSOTEXT(6)="To get a report of patient names/prescriptions that were billed as part of this"
+12 SET PSOTEXT(7)="clean-up, enter D RPT^PSOCPIB3 at the programmer's prompt."
End DoDot:1
+13 IF PSOCNT=0
SET PSOTEXT(3)="No released unbilled copay fills were found to reprocess."
+14 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+15 QUIT
+16 ;
MAIL2 ; SEND NAME INFO FOR USE BY AAC
+1 KILL XMY,PSOTEXT
+2 SET PSOCNT=0
+3 SET PSOINST=$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)),"^")
+4 SET XMY(DUZ)=""
+5 SET XMY("WHITE.ELAINE@DOMAIN.NAME")=""
+6 SET XMY("CARROLL.DAN@DOMAIN.NAME")=""
+7 SET XMDUZ="PSO*7*123"
SET XMSUB=$GET(PSOINST)_" - AAC DATA"
+8 SET PSONAM=""
FOR
SET PSONAM=$ORDER(^XTMP("PSOCPIB3",$JOB,"BILLED",PSONAM))
IF PSONAM=""
QUIT
SET PSODFN=""
FOR
SET PSODFN=$ORDER(^XTMP("PSOCPIB3",$JOB,"BILLED",PSONAM,PSODFN))
IF PSODFN=""
QUIT
Begin DoDot:1
+9 SET DFN=PSODFN
DO DEM^VADPT
+10 SET PSOCNT=PSOCNT+1
SET PSOTEXT(PSOCNT)=PSOINST_"^"_$GET(VA("BID"))_$EXTRACT($PIECE(PSONAM,","),1,5)
End DoDot:1
+11 IF '$DATA(PSOTEXT)
SET PSOTEXT(1)="NO BILLED FILLS FOR INSTITUTION: "_PSOINST
+12 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+13 QUIT
+14 ;
BILL ;
+1 ; IF NO IB NUMBER FOR THIS FILL, SET UP VARIABLES AND CALL CP^PSOCP. IF THERE IS AN IB NUMBER AFTER THIS CALL, COUNT IT FOR SUMMARY MAIL MSG
+2 SET PSODFN=""
FOR
SET PSODFN=$ORDER(^XTMP("PSOCPBAK",PSOJ,PSODFN))
IF 'PSODFN
QUIT
Begin DoDot:1
+3 ; EXEMPT OR SC QUESTION APPLIES
IF $GET(^XTMP("PSOCPBAK",PSOJ,PSODFN))
QUIT
+4 SET PSOCAP(302)=0
+5 SET PSOCAP(303)=0
+6 SET RXP=""
FOR
SET RXP=$ORDER(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP))
IF 'RXP
QUIT
SET YY=""
FOR
SET YY=$ORDER(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP,YY))
IF YY=""
QUIT
Begin DoDot:2
+7 SET PSOREL=$GET(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP,YY))
+8 ; NUMBER OF 30-DAY UNITS ELIGIBLE TO BILL
SET PSOCPUN=$PIECE(($PIECE(^PSRX(RXP,0),"^",8)+29)/30,".",1)
+9 SET PSOSVUN=PSOCPUN
+10 DO CHKTOT
+11 ; ANNUAL CAP MET
IF PSOCAP($EXTRACT(PSOREL,1,3))
QUIT
+12 IF 'YY
Begin DoDot:3
+13 ; ALREADY BILLED
IF $PIECE($GET(^PSRX(RXP,"IB")),"^",2)'=""
QUIT
+14 DO SITE^PSOCPBA2
+15 DO CP^PSOCP
+16 SET PSOBILL=$PIECE($GET(^PSRX(RXP,"IB")),"^",2)
IF PSOBILL'=""
Begin DoDot:4
+17 SET PSONAM=$PIECE($GET(^DPT(PSODFN,0)),"^")
IF PSONAM=""
SET PSONAM="UNKNOWN"
+18 SET PSORXP=$PIECE($GET(^PSRX(RXP,0)),"^")
IF PSORXP=""
QUIT
+19 SET PSOCNT=PSOCNT+1
+20 SET ^XTMP("PSOCPIB3",$JOB,"BILLED",PSONAM,PSODFN,PSORXP,YY)=$PIECE(PSOREL,".")
+21 DO ACCUM
End DoDot:4
End DoDot:3
QUIT
+22 ; REFILL LEVEL
IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",1)=""
Begin DoDot:3
+23 DO SITE^PSOCPBA2
+24 DO CP^PSOCP
+25 SET PSOBILL=$PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",1)
IF PSOBILL'=""
Begin DoDot:4
+26 SET PSONAM=$PIECE($GET(^DPT(PSODFN,0)),"^")
IF PSONAM=""
SET PSONAM="UNKNOWN"
+27 SET PSORXP=$PIECE($GET(^PSRX(RXP,0)),"^")
IF PSORXP=""
QUIT
+28 SET PSOCNT=PSOCNT+1
+29 SET ^XTMP("PSOCPIB3",$JOB,"BILLED",PSONAM,PSODFN,PSORXP,YY)=$PIECE(PSOREL,".")
+30 DO ACCUM
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
+1 SET PSOQUES="Queue copay clean-up Job to run Date@Time: "
+2 DO GETDATE^PSOCPIB4
+3 QUIT
+4 ;
RPT ;
+1 LOCK +^XTMP("PSOCPIB3"):0
IF '$TEST
Begin DoDot:1
+2 WRITE !,"Clean up job for PSO*7*123 is still running. Halting..."
End DoDot:1
QUIT
+3 LOCK -^XTMP("PSOCPIB3")
+4 WRITE !!,"This report shows the patient name and prescription information for fills"
+5 WRITE !,"that were billed as part of patch PSO*7*123 clean-up."
+6 WRITE !!,"You may queue the report to print, if you wish.",!
+7 ;
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^PSOCPIB3"
SET ZTDESC="Billed copay report"
DO ^%ZTLOAD
KILL %ZSI
WRITE !,"Report queued to print.",!
GOTO DONE
START ;
+1 USE IO
+2 SET PSOOUT=0
SET PSODV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")
+3 SET PSOPGCT=0
SET PSOPGLN=IOSL-7
SET PSOPGCT=1
+4 DO TITLE
+5 SET PSOJ=0
+6 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
+7 WRITE !
+8 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
+9 NEW XX
+10 SET XX=$GET(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL))
Begin DoDot:3
+11 DO FULL
IF $GET(PSOOUT)
QUIT
WRITE !,PSONAM
DO PRTSSN
+12 WRITE ?39," ",RXP," (",PSOFILL,")"
Begin DoDot:4
+13 SET Y=XX
IF Y>0
XECUTE ^DD("DD")
+14 WRITE ?65," ",Y
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 GOTO END
+16 ;
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*123 -COPAY PRESCRIPTION FILLS BILLED"
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",?40,"RX# (FILL)",?66,"RELEASE DATE"
+8 WRITE !,"------------------------",?40,"----------",?66,"------------"
+9 SET PSOPGCT=PSOPGCT+1
+10 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
+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 ;
ACCUM ; ACCUMULATE TOTALS AND SEE IF PATIENT MET ANNUAL CAP
+1 SET PSOYR=$EXTRACT(PSOREL,1,3)
+2 SET PSOCPUN=PSOSVUN
+3 IF PSOYR'=302
IF PSOYR'=303
QUIT
+4 SET PSOTOT=$GET(^XTMP("PSOCPIB3",$JOB,PSODFN,PSOYR))
+5 SET ^XTMP("PSOCPIB3",$JOB,PSODFN,PSOYR)=PSOTOT+(PSOCPUN*7)
+6 QUIT
+7 ;
CHKTOT ; SEE IF BILLING THIS FILL WOULD GO OVER CAP
+1 SET PSOYR=$EXTRACT(PSOREL,1,3)
+2 IF PSOYR'=302
IF PSOYR'=303
QUIT
+3 SET PSOTOT=$GET(^XTMP("PSOCPIB3",$JOB,PSODFN,PSOYR))
+4 IF 'PSOTOT
Begin DoDot:1
+5 SET PSOSQ=0
FOR
SET PSOSQ=$ORDER(^IBAM(354.7,PSODFN,1,PSOSQ))
IF 'PSOSQ
QUIT
SET PSOLOG=$GET(^IBAM(354.7,PSODFN,1,PSOSQ,0))
IF $EXTRACT(PSOLOG,1,3)=PSOYR
Begin DoDot:2
+6 ; DON'T LOOK AT JANUARY 2002 TOTALS
IF $EXTRACT(PSOLOG,1,5)="30201"
QUIT
+7 SET PSOTOT=PSOTOT+$PIECE(PSOLOG,"^",2)
End DoDot:2
End DoDot:1
SET ^XTMP("PSOCPIB3",$JOB,PSODFN,PSOYR)=PSOTOT
+8 ; BILLING FOR THIS WOULD EXCEED ANNUAL CAP
IF PSOYR=302
IF PSOTOT+(7*PSOCPUN)>770
SET PSOCAP(PSOYR)=1
QUIT
+9 ; BILLING FOR THIS WOULD EXCEED ANNUAL CAP
IF PSOYR=303
IF PSOTOT+(7*PSOCPUN)>840
SET PSOCAP(PSOYR)=1
QUIT
+10 QUIT
+11 ;
