Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOCPBK1

PSOCPBK1.m

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