234 lines
9.5 KiB
Mathematica
234 lines
9.5 KiB
Mathematica
PSOCPBK1 ;BIR/EJW,GN-Tally unbilled Automated-release refill copays ;8/10/05 12:50pm
|
|
;;7.0;OUTPATIENT PHARMACY;**215**;DEC 1997
|
|
;External reference to ^XUSEC supported by DBIA 10076
|
|
;External reference to IBARX supported by DBIA 125
|
|
;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
|
|
;
|
|
N DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC
|
|
I '$D(XPDQUES("POS1")) D Q:'ZTDTH
|
|
.K DIR
|
|
.S DIR("A")="Enter when to Queue the Tally job to run in date@time format "
|
|
.S DIR("B")="NOW"
|
|
.S DIR(0)="D^::%DT"
|
|
.S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 081505@3:30p"
|
|
.D ^DIR I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S ZTDTH="" Q
|
|
.S ZTDTH=$$FMTH^XLFDT(Y)
|
|
;
|
|
I $D(XPDQUES("POS1")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS1"))
|
|
;
|
|
D BMES^XPDUTL("===================================================")
|
|
D MES^XPDUTL("Queuing background job to tally unbilled refills...")
|
|
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
|
|
D MES^XPDUTL("===================================================")
|
|
L +^XTMP($$NAMSP):0 I '$T D Q
|
|
. I ZTDTH="" D BMES^XPDUTL("Tally job is already running. Halting...")
|
|
L -^XTMP($$NAMSP)
|
|
S ZTRTN="EN^PSOCPBK1",ZTIO=""
|
|
S ZTDESC="Background job to tally unbilled copays for refills via OPAI"
|
|
D ^%ZTLOAD
|
|
D:$D(ZTSK)
|
|
.D BMES^XPDUTL("=========================")
|
|
.D MES^XPDUTL("Task #"_ZTSK_" Queued!")
|
|
.D MES^XPDUTL("=========================")
|
|
.D BMES^XPDUTL("")
|
|
D BMES^XPDUTL("")
|
|
K XPDQUES
|
|
Q
|
|
EN ;
|
|
N NAMSP S NAMSP=$$NAMSP
|
|
;if can't get Lock, then already running.
|
|
L +^XTMP(NAMSP):3 I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
|
|
;if got a lock then must be fresh start, kill possible old Xtmp
|
|
K ^XTMP(NAMSP)
|
|
N PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS,PSOTRX,XIEN
|
|
N PSOSCMX,PSODFN,PSOREL,PSOAMT,FOUND,V24,PSOTRF,PSOEND2,PSOSTRT2,QQ
|
|
N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,LIN,%,X1,XMY,STOP
|
|
D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
|
|
S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
|
|
I '$G(DT) S DT=$$DT^XLFDT
|
|
I '$D(^XTMP(NAMSP)) S X1=DT D C^%DTC S ^XTMP(NAMSP,0)=$G(X)_"^"_DT_"^Tally of unbilled copays for refills via OPAI, PSO*7*215"
|
|
;
|
|
;get 1st occurence of install date of patch PSO*7*156 (OPAI)
|
|
S XIEN=+$O(^XPD(9.7,"B","PSO*7.0*156",0))
|
|
S PSODT=+$P($G(^XPD(9.7,XIEN,1)),"^",3)
|
|
I 'PSODT S ^XTMP(NAMSP,0,.1)="OPAI PATCH PSO*7*156 IS NOT INSTALLED" D MAIL3^PSOCPBK2(^XTMP(NAMSP,0,.1)) Q
|
|
;
|
|
;check if any division is on v2.4 (OPAI interface)
|
|
S V24=0
|
|
F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D Q:V24
|
|
. S:+$G(^PS(59,XX,"DISP"))=2.4 V24=1
|
|
I 'V24 D Q
|
|
. S ^XTMP(NAMSP,0,.2)="OPAI IS INSTALLED BUT IS NOT TURNED ON"
|
|
. D MAIL3^PSOCPBK2(^XTMP(NAMSP,0,.2))
|
|
;
|
|
S (PSOTRX,PSOTRF)=1
|
|
K ^XTMP(NAMSP,0,"STOP") S STOP=0 ;init stop flag to 0
|
|
F QQ=1:1 S PSODT=$O(^PSRX("AL",PSODT)) Q:'PSODT D Q:STOP
|
|
.I QQ#100=0,$D(^XTMP(NAMSP,0,"STOP")) K ^XTMP(NAMSP) S STOP=1 Q
|
|
.S RXP=""
|
|
.F PSOTRX=PSOTRX+1:1 S RXP=$O(^PSRX("AL",PSODT,RXP)) Q:'RXP D
|
|
..;save last date & fill info
|
|
..S ^XTMP(NAMSP,0,"LAST")=PSODT_"^"_RXP_"^"_PSOTRX
|
|
..S PSODFN=$P($G(^PSRX(RXP,0)),"^",2)
|
|
..Q:('PSODFN)!('$D(^DPT(PSODFN,0))) ;quit, no valid DFN info
|
|
..D XTYPE
|
|
..Q:+PSOSCMX=0 ;quit, Exempt or deceased
|
|
..;search refills only, ignore 0=orig fill
|
|
..F YY=0:0 S YY=$O(^PSRX("AL",PSODT,RXP,YY)) Q:'YY D ADDBILL
|
|
Q:STOP
|
|
;
|
|
S PSOCNT=0
|
|
D TALLY^PSOCPBK2 Q:STOP
|
|
D TOTAL
|
|
D MAIL
|
|
D MAIL2
|
|
L -^XTMP(NAMSP)
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
;
|
|
ADDBILL ;add to billable ^XTMP if ok, quit if not
|
|
S PSOTRF=PSOTRF+1
|
|
S PSOREL=$P($G(^PSRX(RXP,1,YY,0)),"^",18)
|
|
Q:'PSOREL ;not released
|
|
Q:'YY ;orig fill
|
|
Q:+$$RXST^IBARXEU(PSODFN,$P(PSOREL,".")) ;Exempt on Rel dte
|
|
;check refill
|
|
Q:$P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" ;already billed
|
|
Q:$P($G(^PSRX(RXP,1,YY,"IB")),"^",2)'="" ;exceeded ann. cap
|
|
;
|
|
;look for Activity log entry per refill # with the below text
|
|
S FOUND=0
|
|
F XX=999:0 S XX=$O(^PSRX(RXP,"A",XX),-1) Q:'XX D Q:FOUND
|
|
.Q:$P(^PSRX(RXP,"A",XX,0),"^",4)'=YY
|
|
.Q:^PSRX(RXP,"A",XX,0)'["External Interface Dispensing is Complete"
|
|
.S FOUND=1
|
|
Q:'FOUND
|
|
;
|
|
S ^XTMP(NAMSP,PSODFN,RXP,YY)=$P(PSOREL,".") ;add to XTMP to be bill
|
|
Q
|
|
;
|
|
MAIL ;
|
|
N TOTAMT,PSOCXPDA
|
|
D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
|
|
S PSOEND2=$$FMTE^XLFDT(%,"1PS")
|
|
I $G(DUZ) S XMY(DUZ)=""
|
|
S XMDUZ="Outpatient Pharmacy",XMSUB="Outpatient Pharmacy Copay Tally"
|
|
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 tally job for the Outpatient Pharmacy patch (PSO*7*215)"
|
|
S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
|
|
I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay fills were found."
|
|
I PSOCNT>0 D
|
|
.S TOTAMT=0
|
|
.F XX="YR2004","YR2005" D
|
|
..F YY=1:1:3 S PSOAMT(XX,YY)=PSOCNT(XX,YY)*YY*7,TOTAMT=TOTAMT+PSOAMT(XX,YY)
|
|
.S PSOTEXT(3)="Auto-Released refills have now been marked as potentials for back billing."
|
|
.S PSOTEXT(4)="There were "_$FN(PSOCNT,",")_" fills successfully tallied for "_$FN(PSOVETS,",")_" veterans."
|
|
.S PSOTEXT(5)=" "
|
|
.S PSOTEXT(6)="Fills eligible for back-billing by year:"
|
|
.S PSOTEXT(7)="2004 30-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2004",1),6)
|
|
.S PSOTEXT(7)=PSOTEXT(7)_" $"_$J($FN(PSOAMT("YR2004",1),","),9)
|
|
.S PSOTEXT(8)="2004 60-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2004",2),6)
|
|
.S PSOTEXT(8)=PSOTEXT(8)_" $"_$J($FN(PSOAMT("YR2004",2),","),9)
|
|
.S PSOTEXT(9)="2004 90-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2004",3),6)
|
|
.S PSOTEXT(9)=PSOTEXT(9)_" $"_$J($FN(PSOAMT("YR2004",3),","),9)
|
|
.S PSOTEXT(10)=""
|
|
.S PSOTEXT(11)="2005 30-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2005",1),6)
|
|
.S PSOTEXT(11)=PSOTEXT(11)_" $"_$J($FN(PSOAMT("YR2005",1),","),9)
|
|
.S PSOTEXT(12)="2005 60-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2005",2),6)
|
|
.S PSOTEXT(12)=PSOTEXT(12)_" $"_$J($FN(PSOAMT("YR2005",2),","),9)
|
|
.S PSOTEXT(13)="2005 90-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2005",3),6)
|
|
.S PSOTEXT(13)=PSOTEXT(13)_" $"_$J($FN(PSOAMT("YR2005",3),","),9)
|
|
.S PSOTEXT(14)=" =========="
|
|
.S PSOTEXT(15)=" TOTAL $"_$J($FN(TOTAMT,","),9)
|
|
.S PSOTEXT(16)=" "
|
|
.S PSOTEXT(17)="To get a report of patients/prescriptions that were identified as potentially"
|
|
.S PSOTEXT(18)="billable as part of this Tally, enter D RPT^PSOCPBK2 at the programmer's prompt"
|
|
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
|
|
Q
|
|
;
|
|
MAIL2 ;
|
|
S LIN="",$P(LIN," ",80)=""
|
|
D NOW^%DTC S PSOTIME=$$FMDIFF^XLFDT(%,$G(PSOS1),2)
|
|
S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
|
|
S PSOSTNM=$P($G(^DIC(4,PSOINST,0)),"^")
|
|
K PSOTEXT
|
|
S XMY(DUZ)="",PSOTC=0,PSOCNTS=""
|
|
F J="YR2004","YR2005" F I=1:1:3 D
|
|
.S PSOTC=PSOTC+PSOCNT(J,I)
|
|
.S PSOCNTS=PSOCNTS_","_PSOCNT(J,I)
|
|
S XMY("NAPOLIELLO.GREG@FORUM.VA.GOV")=""
|
|
S XMY("WHITE.ELAINE@FORUM.VA.GOV")=""
|
|
S:$$PROD^XUPROD(1) XMY("WILLIAMSON.ERIC@FORUM.VA.GOV")=""
|
|
S XMDUZ="PSO*7*215 TALLY"
|
|
S XMSUB="STATION "_$G(PSOINST)
|
|
S XMSUB=XMSUB_$S($$PROD^XUPROD(1):"(Prod)",1:"(Test)")
|
|
S XMSUB=XMSUB_" UNBILLED COPAYS FOR PRESCRIPTION REFILLS"
|
|
S PSOTEXT(1)=" Start time: "_PSOSTRT2
|
|
S PSOTEXT(2)=" Completed time: "_PSOEND2
|
|
S PSOTEXT(3)=" Elapsed Time: "_$$ETIME^PSOCPBK2(PSOTIME)
|
|
S PSOTEXT(4)=""
|
|
S PSOTEXT(5)=" Total RX's processed: "_$J($FN(PSOTRX,","),8)
|
|
S PSOTEXT(6)=" Total Refills processed: "_$J($FN(PSOTRF,","),8)
|
|
S PSOTEXT(7)=" Total billable refills: "_$J($FN(PSOTC,","),8)
|
|
S PSOTEXT(8)=" Total billable vets: "_$J($FN(PSOVETS,","),8)
|
|
S PSOTEXT(9)=""
|
|
S PSOTEXT(10)="Excel comma delimited data below, Two heading, one data line"
|
|
S PSOTEXT(11)=""
|
|
S PSOTEXT(12)="Copy and paste any of the 2 heading & 1 data rows into Excel. Then click "
|
|
S PSOTEXT(13)="'Data', 'Text to Columns..', check 'Delimited', click Next, check 'Comma',"
|
|
S PSOTEXT(14)="and click Finish"
|
|
S PSOTEXT(15)=""
|
|
S PSOTEXT(16)=$E(("Station,Station,,2004,,,2005"_LIN),1,79)
|
|
S PSOTEXT(17)=$E(("Name,#,30 days,60 days,90 days,30 days,60 days,90 days"_LIN),1,79)
|
|
S PSOTEXT(18)=$E((PSOSTNM_","_PSOINST_PSOCNTS_LIN),1,79)
|
|
S PSOTEXT(19)=""
|
|
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
|
|
Q
|
|
;
|
|
XTYPE ;
|
|
N Y,VADM,I,J,X,SAVY,DFN
|
|
S DFN=PSODFN D DEM^VADPT I +$G(VADM(6)) S PSOSCMX="" Q ; DECEASED
|
|
S (X,PSOSCMX,SAVY)=""
|
|
S J=0 F S J=$O(^PS(59,J)) Q:'J I +$G(^(J,"IB")) S X=+^("IB") Q
|
|
I 'X Q
|
|
S X=X_"^"_PSODFN D XTYPE^IBARX
|
|
I $G(Y)'=1 Q
|
|
S J="" F S J=$O(Y(J)) Q:'J S I="" F S SAVY=I,I=$O(Y(J,I)) Q:I="" S:I>0 PSOSCMX=I
|
|
I PSOSCMX="",SAVY=0 Q ; INCOME EXEMPT OR SERVICE-CONNECTED
|
|
I PSOSCMX=2 Q ; NEED TO ASK SC QUESTION
|
|
Q
|
|
;
|
|
TOTAL ;
|
|
N COUNT,COUNTED
|
|
I '$D(PSOVETS) S PSOVETS=0
|
|
N I,J
|
|
F I=1:1:3 S (PSOCNT("YR2004",I),PSOCNT("YR2005",I))=0
|
|
S PSODFN=0 F S PSODFN=$O(^XTMP(NAMSP,PSODFN)) Q:'PSODFN D
|
|
.S COUNTED=0
|
|
.F J="YR2004","YR2005" F I=1:1:3 S COUNT=$G(^XTMP(NAMSP,PSODFN,J,I)) I COUNT>0 S:'$G(COUNTED) COUNTED=1,PSOVETS=PSOVETS+1 S PSOCNT(J,I)=PSOCNT(J,I)+COUNT
|
|
F I=1:1:3 S PSOCNT=PSOCNT+PSOCNT("YR2004",I)+PSOCNT("YR2005",I)
|
|
Q
|
|
;
|
|
STATUS ;show status of job running
|
|
I $$ST D
|
|
.W !,"Currently processing:"
|
|
.W !?5,"Released Date > ",+^XTMP($$NAMSP,0,"LAST")
|
|
.W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",2)
|
|
.W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",3),!
|
|
Q
|
|
;
|
|
STOP ;stop job command
|
|
I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
|
|
.W !,"Outpatient RX Copay Tally Job - set to STOP Soon"
|
|
.W !!,"Check Status to be sure it has stopped and is not running..."
|
|
.W !," (D STATUS^PSOCPBK1)"
|
|
Q
|
|
ST() ;status
|
|
L +^XTMP($$NAMSP):3 I $T D Q 0
|
|
.L -^XTMP($$NAMSP)
|
|
.W !,"*** TALLY NOT CURRENTLY RUNNING! ***",!
|
|
Q 1
|
|
NAMSP() ;
|
|
Q $T(+0)
|