140 lines
6.4 KiB
Mathematica
140 lines
6.4 KiB
Mathematica
PSOCPBAK ;BIR/EJW-Tally unbilled NON-SERVICE CONNECTED copays ;03/28/03
|
|
;;7.0;OUTPATIENT PHARMACY;**137,268**;DEC 1997;Build 9
|
|
;External reference to ^XUSEC supported by DBIA 10076
|
|
;External reference to IBARX supported by DBIA 125
|
|
S ZTDTH=""
|
|
I $D(ZTQUEUED) S ZTDTH=$H
|
|
L +^XTMP("PSOCPBAK"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D Q
|
|
. I ZTDTH="" D BMES^XPDUTL("Tally job is already running. Halting...")
|
|
L -^XTMP("PSOCPBAK")
|
|
I ZTDTH="" D
|
|
.D BMES^XPDUTL("Tally 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 tally unbilled NON-SERVICE CONNECTED fills...")
|
|
S ZTRTN="EN^PSOCPBAK",ZTIO="",ZTDESC="Background job to tally NON-SERVICE CONNECTED unbilled copays" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
|
|
W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
|
|
Q
|
|
EN ;
|
|
L +^XTMP("PSOCPBAK"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
|
|
N PSODT,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS
|
|
S PSOCNT=0
|
|
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("PSOCPBAK")) S X1=DT,X2=+90 D C^%DTC S ^XTMP("PSOCPBAK",0)=$G(X)_"^"_DT
|
|
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
|
|
.I BADDT,BADDT'>$P(PSODT,".") D
|
|
..I '$D(^XTMP("PSOCPBAK",$J,PSODFN)) D XTYPE 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
|
|
D TALLY^PSOCPBA2
|
|
D TOTAL
|
|
D MAIL
|
|
D MAIL2
|
|
L -^XTMP("PSOCPBAK")
|
|
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 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*137)"
|
|
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 tallied for "_$G(PSOVETS)_" veterans." D
|
|
.S PSOTEXT(5)=" "
|
|
.S PSOTEXT(6)="Fills eligible for back-billing by year:"
|
|
.S PSOTEXT(7)="2002 30-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",1)
|
|
.S PSOTEXT(8)="2002 60-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",2)
|
|
.S PSOTEXT(9)="2002 90-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",3)
|
|
.S PSOTEXT(10)=""
|
|
.S PSOTEXT(11)="2003 30-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",1)
|
|
.S PSOTEXT(12)="2003 60-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",2)
|
|
.S PSOTEXT(13)="2003 90-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",3)
|
|
I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay fills were found."
|
|
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
|
|
Q
|
|
;
|
|
MAIL2 ;
|
|
N I,COUNTS
|
|
D NOW^%DTC S PSOTIME=$$FMDIFF^XLFDT(%,PSOS1,2)
|
|
S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
|
|
K PSOTEXT
|
|
S COUNTS=""
|
|
F J="YR2002","YR2003" F I=1:1:3 S COUNTS=COUNTS_"^"_PSOCNT(J,I)
|
|
K XMY(DUZ)
|
|
S XMY("WHITE.ELAINE@FORUM.VA.GOV")=""
|
|
S XMY("CARROLL.DAN@FORUM.VA.GOV")=""
|
|
S XMDUZ="PSO*7*137 TALLY",XMSUB=$G(PSOINST)_" - COUNTS"
|
|
S PSOTEXT(1)=PSOSTRT2_"^"_PSOTIME_"^"_$G(PSOVETS)_"^"_PSOCNT_COUNTS
|
|
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
|
|
Q
|
|
;
|
|
CHKLOG ;
|
|
S BADDT=""
|
|
S PSOSQ=0 F S PSOSQ=$O(^PSRX(RXP,"COPAY",PSOSQ)) Q:'PSOSQ S PSOLOG=$G(^PSRX(RXP,"COPAY",PSOSQ,0)) I PSOLOG["Service Connected" S BADDT=$P(PSOLOG,".") Q
|
|
Q
|
|
;
|
|
GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
|
|
S ZTDTH=""
|
|
S NOW=0
|
|
D NOW^%DTC S (Y,TODAY)=% D DD^%DT
|
|
D BMES^XPDUTL("At the following prompt, enter a starting date@time")
|
|
D MES^XPDUTL("or enter NOW to queue the job immediately.")
|
|
D BMES^XPDUTL("If this prompting is during patch installation, you will not see what you type.")
|
|
W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue copay tally Job to run Date@Time: "
|
|
D ^%DT K %DT I $D(DTOUT)!(Y<0) W "Task will be queued to run NOW" S ZTDTH=$H,NOW=1
|
|
I 'NOW,Y>0 D
|
|
.S SAVEY=Y
|
|
.D DD^%DT
|
|
.S X=Y
|
|
.S Y=SAVEY
|
|
ASK D BMES^XPDUTL("Task will be queued to run "_$S(NOW:"NOW",1:X)_". Is that correct? :")
|
|
R XX:300 S:'$T XX="Y" I XX'="Y",XX'="y",XX'="N",XX'="n" W " Enter Y or N" G ASK
|
|
I XX'="Y",XX'="y" G GETDATE
|
|
I Y>0,ZTDTH="" S ZTDTH=Y
|
|
I ZTDTH="" S ZTDTH=$H
|
|
Q
|
|
;
|
|
XTYPE ;
|
|
N Y,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("YR2002",I),PSOCNT("YR2003",I))=0
|
|
S PSODFN=0 F S PSODFN=$O(^XTMP("PSOCPBAK",$J,PSODFN)) Q:'PSODFN D
|
|
.S COUNTED=0
|
|
.F J="YR2002","YR2003" F I=1:1:3 S COUNT=$G(^XTMP("PSOCPBAK",$J,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("YR2002",I)+PSOCNT("YR2003",I)
|
|
Q
|
|
;
|