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