- 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 Feb 18, 2025@23:52:12 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)