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

PSOCPIB3.m

Go to the documentation of this file. 
  1. PSOCPIB3 ;BIR/EJW-Clean up to bill unbilled NON-SERVICE CONNECTED copays ;12/12/02
  1.  ;;7.0;OUTPATIENT PHARMACY;**123**;DEC 1997
  1.  ;External reference to ^XUSEC supported by DBIA 10076
  1.  ;External reference to ^IBAM(354.7 supported by DBIA 3877
  1.  S ZTDTH=""
  1.  I $D(ZTQUEUED) S ZTDTH=$H
  1.  L +^XTMP("PSOCPIB3"):0 I '$T D  Q
  1.  . I ZTDTH="" D BMES^XPDUTL("Clean up job is already running.  Halting...")
  1.  L -^XTMP("PSOCPIB3")
  1.  I ZTDTH="" D
  1.  .D BMES^XPDUTL("Clean up for unbilled, released NON-SERVICE CONNECTED prescription fills.")
  1.  .D BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be ")
  1.  .D MES^XPDUTL("queued to run NOW.")
  1.  .D GETDATE
  1.  .D BMES^XPDUTL("Queuing background job to reprocess unbilled NON-SERVICE CONNECTED fills...")
  1.  S ZTRTN="EN^PSOCPIB3",ZTIO="",ZTDESC="Background job to reprocess NON-SERVICE CONNECTED unbilled copays" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
  1.  W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
  1.  Q
  1. EN ;
  1.  L +^XTMP("PSOCPIB3"):0 I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
  1.  N PSODT,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND
  1.  S PSOCNT=0
  1.  D NOW^%DTC S Y=% D DD^%DT S PSOSTART=Y
  1.  I '$G(DT) S DT=$$DT^XLFDT
  1.  I '$D(^XTMP("PSOCPIB3")) S X1=DT,X2=+90 D C^%DTC S ^XTMP("PSOCPIB3",0)=$G(X)_"^"_DT
  1.  I $D(^XTMP("PSOCPBAK")) G PROCESS ; POTENTIALLY BILLABLE FILLS ALREADY IDENTIFIED
  1.  S PSODT=3020203.235959 ; START WITH DATE $7 COPAY WENT INTO EFFECT
  1.  F  S PSODT=$O(^PSRX("AL",PSODT)) Q:'PSODT  S RXP="" F  S RXP=$O(^PSRX("AL",PSODT,RXP)) Q:'RXP  D
  1.  .S PSODFN=$P($G(^PSRX(RXP,0)),"^",2) Q:PSODFN=""  I '$D(^DPT(PSODFN,0)) Q
  1.  .I $G(^XTMP("PSOCPBAK",$J,PSODFN)) Q  ; EXEMPT OR SC QUESTION APPLIES-- NOTHING TO REPROCESS FOR THIS PATIENT
  1.  .S BADDT=$G(^XTMP("PSOCPBAK",$J,PSODFN,RXP))
  1.  .I 'BADDT D CHKLOG^PSOCPBAK
  1.  .I BADDT,BADDT'>$P(PSODT,".") D
  1.  ..I '$D(^XTMP("PSOCPBAK",$J,PSODFN)) D XTYPE^PSOCPBAK S ^XTMP("PSOCPBAK",$J,PSODFN)=$S(PSOSCMX=1:"",1:1) I PSOSCMX'=1 Q  ; QUIT IF SC QUESTION APPLIES -- NOTHING TO REPROCESS
  1.  ..S YY="" F  S YY=$O(^PSRX("AL",PSODT,RXP,YY)) Q:YY=""  D
  1.  ...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
  1.  ...I 'YY I $P($G(^PSRX(RXP,"IB")),"^",2)'="" Q  ; ALREADY BILLED
  1.  ...I 'YY I $P($G(^PSRX(RXP,"IB")),"^",4)'="" Q  ; ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
  1.  ...I YY,$P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" Q  ; REFILL ALREADY BILLED
  1.  ...I YY,$P($G(^PSRX(RXP,1,YY,"IB")),"^",2)'="" Q  ; REFILL ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
  1.  ...S PSOXIN=$$RXST^IBARXEU(PSODFN,$P(PSOREL,".")) I $P($G(PSOXIN),"^")=1 Q  ; INCOME EXEMPT ON RELEASE DATE
  1.  ...I '$D(^XTMP("PSOCPBAK",$J,PSODFN,RXP)) S ^XTMP("PSOCPBAK",$J,PSODFN,RXP)=BADDT
  1.  ...S ^XTMP("PSOCPBAK",$J,PSODFN,RXP,YY)=$P(PSOREL,".") ; SAVE TO PROCESS IN "BILL" SECTION
  1. PROCESS ;
  1.  S PSOJ=0 F  S PSOJ=$O(^XTMP("PSOCPBAK",PSOJ)) Q:'PSOJ  D BILL
  1.  D MAIL
  1.  D MAIL2
  1.  L -^XTMP("PSOCPIB3")
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. MAIL ;
  1.  D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
  1.  I $G(DUZ) S XMY(DUZ)=""
  1.  S XMDUZ="Outpatient Pharmacy",XMSUB="Outpatient Pharmacy Copay Clean-up"
  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 clean up job for the Outpatient Pharmacy patch (PSO*7*123)"
  1.  S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
  1.  I PSOCNT>0 S PSOTEXT(3)="Released non-service connected prescriptions have now been reprocessed."
  1.  I PSOCNT>0 S PSOTEXT(4)="There were "_PSOCNT_" fills successfully billed." D
  1.  .S PSOTEXT(5)=" "
  1.  .S PSOTEXT(6)="To get a report of patient names/prescriptions that were billed as part of this"
  1.  .S PSOTEXT(7)="clean-up, enter D RPT^PSOCPIB3 at the programmer's prompt."
  1.  I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay fills were found to reprocess."
  1.  S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
  1.  Q
  1.  ;
  1. MAIL2 ; SEND NAME INFO FOR USE BY AAC
  1.  K XMY,PSOTEXT
  1.  S PSOCNT=0
  1.  S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
  1.  S XMY(DUZ)=""
  1.  S XMY("WHITE.ELAINE@DOMAIN.NAME")=""
  1.  S XMY("CARROLL.DAN@DOMAIN.NAME")=""
  1.  S XMDUZ="PSO*7*123",XMSUB=$G(PSOINST)_" - AAC DATA"
  1.  S PSONAM="" F  S PSONAM=$O(^XTMP("PSOCPIB3",$J,"BILLED",PSONAM)) Q:PSONAM=""  S PSODFN="" F  S PSODFN=$O(^XTMP("PSOCPIB3",$J,"BILLED",PSONAM,PSODFN)) Q:PSODFN=""  D
  1.  .S DFN=PSODFN D DEM^VADPT
  1.  .S PSOCNT=PSOCNT+1,PSOTEXT(PSOCNT)=PSOINST_"^"_$G(VA("BID"))_$E($P(PSONAM,","),1,5)
  1.  I '$D(PSOTEXT) S PSOTEXT(1)="NO BILLED FILLS FOR INSTITUTION: "_PSOINST
  1.  S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
  1.  Q
  1.  ;
  1. BILL ;
  1.  ; IF NO IB NUMBER FOR THIS FILL, SET UP VARIABLES AND CALL CP^PSOCP.  IF THERE IS AN IB NUMBER AFTER THIS CALL, COUNT IT FOR SUMMARY MAIL MSG
  1.  S PSODFN="" F  S PSODFN=$O(^XTMP("PSOCPBAK",PSOJ,PSODFN)) Q:'PSODFN  D
  1.  .I $G(^XTMP("PSOCPBAK",PSOJ,PSODFN)) Q  ; EXEMPT OR SC QUESTION APPLIES
  1.  .S PSOCAP(302)=0
  1.  .S PSOCAP(303)=0
  1.  .S RXP="" F  S RXP=$O(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP)) Q:'RXP  S YY=""  F  S YY=$O(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP,YY)) Q:YY=""  D
  1.  ..S PSOREL=$G(^XTMP("PSOCPBAK",PSOJ,PSODFN,RXP,YY))
  1.  ..S PSOCPUN=$P(($P(^PSRX(RXP,0),"^",8)+29)/30,".",1) ; NUMBER OF 30-DAY UNITS ELIGIBLE TO BILL
  1.  ..S PSOSVUN=PSOCPUN
  1.  ..D CHKTOT
  1.  ..I PSOCAP($E(PSOREL,1,3)) Q  ; ANNUAL CAP MET
  1.  ..I 'YY D  Q
  1.  ...I $P($G(^PSRX(RXP,"IB")),"^",2)'="" Q  ; ALREADY BILLED
  1.  ...D SITE^PSOCPBA2
  1.  ...D CP^PSOCP
  1.  ...S PSOBILL=$P($G(^PSRX(RXP,"IB")),"^",2) I PSOBILL'="" D
  1.  ....S PSONAM=$P($G(^DPT(PSODFN,0)),"^") I PSONAM="" S PSONAM="UNKNOWN"
  1.  ....S PSORXP=$P($G(^PSRX(RXP,0)),"^") I PSORXP="" Q
  1.  ....S PSOCNT=PSOCNT+1
  1.  ....S ^XTMP("PSOCPIB3",$J,"BILLED",PSONAM,PSODFN,PSORXP,YY)=$P(PSOREL,".")
  1.  ....D ACCUM
  1.  ..I $P($G(^PSRX(RXP,1,YY,"IB")),"^",1)="" D  ; REFILL LEVEL
  1.  ...D SITE^PSOCPBA2
  1.  ...D CP^PSOCP
  1.  ...S PSOBILL=$P($G(^PSRX(RXP,1,YY,"IB")),"^",1) I PSOBILL'="" D
  1.  ....S PSONAM=$P($G(^DPT(PSODFN,0)),"^") I PSONAM="" S PSONAM="UNKNOWN"
  1.  ....S PSORXP=$P($G(^PSRX(RXP,0)),"^") I PSORXP="" Q
  1.  ....S PSOCNT=PSOCNT+1
  1.  ....S ^XTMP("PSOCPIB3",$J,"BILLED",PSONAM,PSODFN,PSORXP,YY)=$P(PSOREL,".")
  1.  ....D ACCUM
  1.  Q
  1.  ;
  1. GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
  1.  S PSOQUES="Queue copay clean-up Job to run Date@Time: "
  1.  D GETDATE^PSOCPIB4
  1.  Q
  1.  ;
  1. RPT ;
  1.  L +^XTMP("PSOCPIB3"):0 I '$T D  Q
  1.  . W !,"Clean up job for PSO*7*123 is still running.  Halting..."
  1.  L -^XTMP("PSOCPIB3")
  1.  W !!,"This report shows the patient name and prescription information for fills"
  1.  W !,"that were billed as part of patch PSO*7*123 clean-up."
  1.  W !!,"You may queue the report to print, if you wish.",!
  1.  ;
  1. DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
  1. QUEUE I $D(IO("Q")) S ZTRTN="START^PSOCPIB3",ZTDESC="Billed copay report" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
  1. START ;
  1.  U IO
  1.  S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
  1.  S PSOPGCT=0,PSOPGLN=IOSL-7,PSOPGCT=1
  1.  D TITLE
  1.  S PSOJ=0
  1.  F  S PSOJ=$O(^XTMP("PSOCPIB3",PSOJ)) Q:PSOJ=""  S PSONAM="" F  S PSONAM=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM)) Q:PSONAM=""  S PSODFN="" F  S PSODFN=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN)) Q:PSODFN=""  D
  1.  .W !
  1.  .S RXP="" F  S RXP=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP)) Q:RXP=""  S PSOFILL="" F  S PSOFILL=$O(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL)) Q:PSOFILL=""  D
  1.  ..N XX
  1.  ..S XX=$G(^XTMP("PSOCPIB3",PSOJ,"BILLED",PSONAM,PSODFN,RXP,PSOFILL)) D
  1.  ...D FULL Q:$G(PSOOUT)  W !,PSONAM D PRTSSN
  1.  ...W ?39," ",RXP," (",PSOFILL,")" D
  1.  ....S Y=XX I Y>0 X ^DD("DD")
  1.  ....W ?65," ",Y
  1.  G END
  1.  ;
  1. FULL ;
  1.  I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE
  1.  Q
  1.  ;
  1. TITLE ;
  1.  I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
  1.  ;
  1.  W @IOF D
  1.  . W !,"Patch PSO*7*123 -COPAY PRESCRIPTION FILLS BILLED"
  1.  S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
  1.  F MJT=1:1:79 W "="
  1.  W !,"PATIENT NAME  (SSN)  DIV",?40,"RX# (FILL)",?66,"RELEASE DATE"
  1.  W !,"------------------------",?40,"----------",?66,"------------"
  1.  S PSOPGCT=PSOPGCT+1
  1.  Q
  1. END ;
  1.  I '$G(PSOOUT),$G(PSODV)="C" W !!,"** End of Report **" K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  I $G(PSODV)="C" W !
  1.  E  W @IOF
  1. DONE ;
  1.  K MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
  1.  D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. PRTSSN ;
  1.  N DFN
  1.  S DFN=PSODFN D PID^VADPT
  1.  S PSORXP=$O(^PSRX("B",RXP,"")) I PSORXP="" Q
  1.  S PSODIV=$P($G(^PSRX(PSORXP,2)),"^",9) S:PSODIV'="" PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1)
  1.  W "  ("_$G(VA("BID"))_")"_"  "_PSODIV
  1.  Q
  1.  ;
  1. ACCUM ; ACCUMULATE TOTALS AND SEE IF PATIENT MET ANNUAL CAP
  1.  S PSOYR=$E(PSOREL,1,3)
  1.  S PSOCPUN=PSOSVUN
  1.  I PSOYR'=302,PSOYR'=303 Q
  1.  S PSOTOT=$G(^XTMP("PSOCPIB3",$J,PSODFN,PSOYR))
  1.  S ^XTMP("PSOCPIB3",$J,PSODFN,PSOYR)=PSOTOT+(PSOCPUN*7)
  1.  Q
  1.  ;
  1. CHKTOT ; SEE IF BILLING THIS FILL WOULD GO OVER CAP
  1.  S PSOYR=$E(PSOREL,1,3)
  1.  I PSOYR'=302,PSOYR'=303 Q
  1.  S PSOTOT=$G(^XTMP("PSOCPIB3",$J,PSODFN,PSOYR))
  1.  I 'PSOTOT D  S ^XTMP("PSOCPIB3",$J,PSODFN,PSOYR)=PSOTOT
  1.  .S PSOSQ=0 F  S PSOSQ=$O(^IBAM(354.7,PSODFN,1,PSOSQ)) Q:'PSOSQ  S PSOLOG=$G(^IBAM(354.7,PSODFN,1,PSOSQ,0)) I $E(PSOLOG,1,3)=PSOYR D
  1.  ..I $E(PSOLOG,1,5)="30201" Q  ; DON'T LOOK AT JANUARY 2002 TOTALS
  1.  ..S PSOTOT=PSOTOT+$P(PSOLOG,"^",2)
  1.  I PSOYR=302,PSOTOT+(7*PSOCPUN)>770 S PSOCAP(PSOYR)=1 Q  ; BILLING FOR THIS WOULD EXCEED ANNUAL CAP
  1.  I PSOYR=303,PSOTOT+(7*PSOCPUN)>840 S PSOCAP(PSOYR)=1 Q  ; BILLING FOR THIS WOULD EXCEED ANNUAL CAP
  1.  Q
  1.  ;