PSOCPIBF ;BIR/EJW-Clean up to bill unbilled CMOP copays ;01/14/02
;;7.0;OUTPATIENT PHARMACY;**93**;DEC 1997
;External reference to ^XUSEC supported by DBIA 10076
;External reference to ^XPD(9.7, supported by DBIA 2197
S ZTDTH=""
I $D(ZTQUEUED) S ZTDTH=$H
I ZTDTH="" D
.W !,"The background job to clean up unbilled, released CMOP prescription fills must"
.W !,"be queued to run and complete before 02/01/2002 when tracking for the "
.W !,"annual copay cap begins."
.W !!,"If no start date/time is entered when prompted, the background job will be "
.W !,"queued to run NOW."
.W !
.D PATCHDT
.D CHKSITE
.D GETDATE
.D BMES^XPDUTL("Queuing background job to reprocess unbilled copay CMOP Prescription fills...")
S ZTRTN="EN^PSOCPIBF",ZTIO="",ZTDESC="Background job to bill CMOP unbilled copays" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
Q
EN ;
N PSODATE,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND,PSOSTOP
S PSOCNT=0
S PSOSTOP=0
D NOW^%DTC S Y=% D DD^%DT S PSOSTART=Y
I '$G(DT) S DT=$$DT^XLFDT
I DT>3020201 S PSOSTOP=1 D MAIL Q ; TOO LATE TO RUN CLEAN-UP
S PSOINST=$O(^XPD(9.7,"B","PSX*2.0*35","")) I PSOINST'="" S PSODATE=$P($G(^XPD(9.7,PSOINST,1)),"^",3)
I $G(PSODATE)'="" S PSODATE=PSODATE-1
I $G(PSODATE)="" S PSODATE=3011011 ; DAY BEFORE PSX*2*35 WAS INSTALLED ANYWHERE
F S PSODATE=$O(^PSRX("AR",PSODATE)) Q:'PSODATE S RXP="" F S RXP=$O(^PSRX("AR",PSODATE,RXP)) Q:'RXP S YY="" F S YY=$O(^PSRX("AR",PSODATE,RXP,YY)) Q:YY="" Q:PSOSTOP D
.S PSOIB=+$P($G(^PSRX(RXP,"IB")),"^") I 'PSOIB Q ; NOT MARKED AS A COPAY RX
. ; 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
.I 'YY D Q
..I $P(^PSRX(RXP,"IB"),"^",2)'="" Q
..D NOW^%DTC I %>3020201 S PSOSTOP=1 Q ; STOP IF REACH DATE OF COPAY RATE CHANGE
..D SITE
..I PSODATE>3011231 D CP^PSOCP
..I PSODATE<3020101 D CP^PSOCPIBC ; BEFORE NEW EXEMPTION CHECKS WENT INTO EFFECT
..I $P(^PSRX(RXP,"IB"),"^",2)'="" S PSOCNT=PSOCNT+1
.I $P($G(^PSRX(RXP,1,YY,"IB")),"^",1)="" D
..D NOW^%DTC I %>3020201 S PSOSTOP=1 Q ; STOP IF REACH DATE OF COPAY RATE CHANGE
..D SITE
..I PSODATE>3011231 D CP^PSOCP
..I PSODATE<3020101 D CP^PSOCPIBC ; BEFORE NEW EXEMPTION CHECKS WENT INTO EFFECT
..I $P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" S PSOCNT=PSOCNT+1
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 Clean-up"
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 clean up job for the Outpatient Pharmacy patch (PSO*7*93)"
S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
I PSOCNT>0 S PSOTEXT(3)="Released unbilled copay Rxs have now been reprocessed."
I PSOCNT>0 S PSOTEXT(4)="There were "_PSOCNT_" Rx fills successfully billed."
I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay Rxs were found to reprocess."
I PSOSTOP D
.S PSOTEXT(5)=""
.S PSOTEXT(6)="PROCESSING CANNOT CONTINUE BEYOND JAN. 31,2002 BECAUSE OF COPAY RATE CHANGE."
.I $G(PSODATE)'="" S Y=PSODATE D DD^%DT S PSOTEXT(7)="AT TIME JOB TERMINATED, RELEASE DATE BEING PROCESSED WAS "_Y
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
S:$D(ZTQUEUED) ZTREQ="@"
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
W !!,"Background job must be queued to start by "_$S(Y<3020131:"Jan 30, 2002 or before.",1:"Jan 31, 2002.")
I Y>3020131 S ZTDTH=Y Q ; LET JOB RUN IF IT'S FEB 1,2002 OR LATER. THE MAILMAN MESSAGE WILL SHOW THAT NO CLEAN UP WAS DONE
W !!,"At the following prompt, enter a starting date/time after ",Y,!,"and before "_$S(Y<3020131:"Jan 31, 2002",1:"Feb 1, 2002")," or enter NOW to queue the job immediately."
W !,"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 clean-up 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 I Y>0,$P(Y,".")>3020130 I TODAY<3020131 W !!,"Must queue background job to start on Jan. 30 or before." G GETDATE
I 'NOW,Y>0 D
.S SAVEY=Y
.D DD^%DT
.S X=Y
.S Y=SAVEY
ASK W !!,"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
;
SITE ; SET UP VARIABLES NEEDED BY BILLING
S PSOSITE=$S(YY=0:$P(^PSRX(RXP,2),"^",9),1:$P($G(^PSRX(RXP,1,YY,0)),"^",9))
I PSOSITE="" Q
S PSOPAR=$G(^PS(59,PSOSITE,1))
S PSOSITE7=$P($G(^PS(59,PSOSITE,"IB")),"^")
Q
;
PATCHDT ; SHOW USER WHEN CMOP PATCH WAS FIRST INSTALLED
S PSOFIRST="Oct 12, 2001" ; DEFAULT FOR WHEN FIRST SITE INSTALLED THE PATCH
S PSOINST=$O(^XPD(9.7,"B","PSX*2.0*35","")) I PSOINST'="" S Y=$P($G(^XPD(9.7,PSOINST,1)),"^",3) D DD^%DT S PSOFIRST=Y
W !,"CMOP patch PSX*2*35 was first installed at your facility on ",PSOFIRST
Q
;
CHKSITE ; SEE IF ANY DIVISIONS HAD THE PROBLEM
S PROBTEXT="'BARCODES ON ACTION PROFILES'"
N SITE,PROB
S PROB=0
S SITE="" F S SITE=$O(^PS(59,SITE)) Q:SITE="" I '$P($G(^PS(59,SITE,1)),"^",1) D S PROB=1 Q
.W !!,"The Outpatient Site (File #59) parameter, "_PROBTEXT
.W !,"for one or more outpatient sites is either not defined or set to 'No'."
.W !,"All copay eligible, released CMOP prescription fills from those outpatient"
.W !,"sites would not have been billed since the installation of PSX*2*35."
.W !!,"NOTE: If the estimated number of CMOP prescriptions involved is high based"
.W !,"on when the patch was first installed and the number of outpatient sites "
.W !,"involved, you may want to disable journaling for Integrated Billing and"
.W !,"Accounts Receivable globals ^IB and ^PRCA while the clean up job"
.W !,"is running."
W !!,"When the background job is complete, a MailMan message will be sent to the"
W !,"installer indicating how many copay eligible CMOP prescription fills were "
W !,"successfully billed."
I PROB Q
W !!,"All "_PROBTEXT_" are set to 'YES' for all divisions."
W !,"The MailMan message at the end should indicate that no fills were found to"
W !,"reprocess. (i.e. All released CMOP fills have already been billed.)"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPIBF 6548 printed Sep 23, 2025@20:02:17 Page 2
PSOCPIBF ;BIR/EJW-Clean up to bill unbilled CMOP copays ;01/14/02
+1 ;;7.0;OUTPATIENT PHARMACY;**93**;DEC 1997
+2 ;External reference to ^XUSEC supported by DBIA 10076
+3 ;External reference to ^XPD(9.7, supported by DBIA 2197
+4 SET ZTDTH=""
+5 IF $DATA(ZTQUEUED)
SET ZTDTH=$HOROLOG
+6 IF ZTDTH=""
Begin DoDot:1
+7 WRITE !,"The background job to clean up unbilled, released CMOP prescription fills must"
+8 WRITE !,"be queued to run and complete before 02/01/2002 when tracking for the "
+9 WRITE !,"annual copay cap begins."
+10 WRITE !!,"If no start date/time is entered when prompted, the background job will be "
+11 WRITE !,"queued to run NOW."
+12 WRITE !
+13 DO PATCHDT
+14 DO CHKSITE
+15 DO GETDATE
+16 DO BMES^XPDUTL("Queuing background job to reprocess unbilled copay CMOP Prescription fills...")
End DoDot:1
+17 SET ZTRTN="EN^PSOCPIBF"
SET ZTIO=""
SET ZTDESC="Background job to bill CMOP unbilled copays"
DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+18 if $DATA(ZTSK)&('$DATA(ZTQUEUED))
WRITE !!,"Task Queued !",!
+19 QUIT
EN ;
+1 NEW PSODATE,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND,PSOSTOP
+2 SET PSOCNT=0
+3 SET PSOSTOP=0
+4 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOSTART=Y
+5 IF '$GET(DT)
SET DT=$$DT^XLFDT
+6 ; TOO LATE TO RUN CLEAN-UP
IF DT>3020201
SET PSOSTOP=1
DO MAIL
QUIT
+7 SET PSOINST=$ORDER(^XPD(9.7,"B","PSX*2.0*35",""))
IF PSOINST'=""
SET PSODATE=$PIECE($GET(^XPD(9.7,PSOINST,1)),"^",3)
+8 IF $GET(PSODATE)'=""
SET PSODATE=PSODATE-1
+9 ; DAY BEFORE PSX*2*35 WAS INSTALLED ANYWHERE
IF $GET(PSODATE)=""
SET PSODATE=3011011
+10 FOR
SET PSODATE=$ORDER(^PSRX("AR",PSODATE))
if 'PSODATE
QUIT
SET RXP=""
FOR
SET RXP=$ORDER(^PSRX("AR",PSODATE,RXP))
if 'RXP
QUIT
SET YY=""
FOR
SET YY=$ORDER(^PSRX("AR",PSODATE,RXP,YY))
if YY=""
QUIT
if PSOSTOP
QUIT
Begin DoDot:1
+11 ; NOT MARKED AS A COPAY RX
SET PSOIB=+$PIECE($GET(^PSRX(RXP,"IB")),"^")
IF 'PSOIB
QUIT
+12 ; 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
+13 IF 'YY
Begin DoDot:2
+14 IF $PIECE(^PSRX(RXP,"IB"),"^",2)'=""
QUIT
+15 ; STOP IF REACH DATE OF COPAY RATE CHANGE
DO NOW^%DTC
IF %>3020201
SET PSOSTOP=1
QUIT
+16 DO SITE
+17 IF PSODATE>3011231
DO CP^PSOCP
+18 ; BEFORE NEW EXEMPTION CHECKS WENT INTO EFFECT
IF PSODATE<3020101
DO CP^PSOCPIBC
+19 IF $PIECE(^PSRX(RXP,"IB"),"^",2)'=""
SET PSOCNT=PSOCNT+1
End DoDot:2
QUIT
+20 IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",1)=""
Begin DoDot:2
+21 ; STOP IF REACH DATE OF COPAY RATE CHANGE
DO NOW^%DTC
IF %>3020201
SET PSOSTOP=1
QUIT
+22 DO SITE
+23 IF PSODATE>3011231
DO CP^PSOCP
+24 ; BEFORE NEW EXEMPTION CHECKS WENT INTO EFFECT
IF PSODATE<3020101
DO CP^PSOCPIBC
+25 IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",1)'=""
SET PSOCNT=PSOCNT+1
End DoDot:2
End DoDot:1
MAIL ;
+1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOEND=Y
+2 IF $GET(DUZ)
SET XMY(DUZ)=""
+3 SET XMDUZ="Outpatient Pharmacy"
SET XMSUB="Outpatient Pharmacy Copay Clean-up"
+4 FOR PSOCXPDA=0:0
SET PSOCXPDA=$ORDER(^XUSEC("PSO COPAY",PSOCXPDA))
if 'PSOCXPDA
QUIT
SET XMY(PSOCXPDA)=""
+5 ; no recipients for mail message
IF $ORDER(XMY(""))=""
QUIT
+6 SET PSOTEXT(1)="The Rx copay clean up job for the Outpatient Pharmacy patch (PSO*7*93)"
+7 SET PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
+8 IF PSOCNT>0
SET PSOTEXT(3)="Released unbilled copay Rxs have now been reprocessed."
+9 IF PSOCNT>0
SET PSOTEXT(4)="There were "_PSOCNT_" Rx fills successfully billed."
+10 IF PSOCNT=0
SET PSOTEXT(3)="No released unbilled copay Rxs were found to reprocess."
+11 IF PSOSTOP
Begin DoDot:1
+12 SET PSOTEXT(5)=""
+13 SET PSOTEXT(6)="PROCESSING CANNOT CONTINUE BEYOND JAN. 31,2002 BECAUSE OF COPAY RATE CHANGE."
+14 IF $GET(PSODATE)'=""
SET Y=PSODATE
DO DD^%DT
SET PSOTEXT(7)="AT TIME JOB TERMINATED, RELEASE DATE BEING PROCESSED WAS "_Y
End DoDot:1
+15 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+16 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+17 QUIT
+18 ;
GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
+1 SET ZTDTH=""
+2 SET NOW=0
+3 DO NOW^%DTC
SET (Y,TODAY)=%
DO DD^%DT
+4 WRITE !!,"Background job must be queued to start by "_$SELECT(Y<3020131:"Jan 30, 2002 or before.",1:"Jan 31, 2002.")
+5 ; LET JOB RUN IF IT'S FEB 1,2002 OR LATER. THE MAILMAN MESSAGE WILL SHOW THAT NO CLEAN UP WAS DONE
IF Y>3020131
SET ZTDTH=Y
QUIT
+6 WRITE !!,"At the following prompt, enter a starting date/time after ",Y,!,"and before "_$SELECT(Y<3020131:"Jan 31, 2002",1:"Feb 1, 2002")," or enter NOW to queue the job immediately."
+7 WRITE !,"If this prompting is during patch installation, you will not see what you type."
+8 WRITE !
KILL %DT
DO NOW^%DTC
SET %DT="RAEX"
SET %DT(0)=%
SET %DT("A")="Queue copay clean-up Job to run Date/Time: "
+9 DO ^%DT
KILL %DT
IF $DATA(DTOUT)!(Y<0)
WRITE "Task will be queued to run NOW"
SET ZTDTH=$HOROLOG
SET NOW=1
+10 IF 'NOW
IF Y>0
IF $PIECE(Y,".")>3020130
IF TODAY<3020131
WRITE !!,"Must queue background job to start on Jan. 30 or before."
GOTO GETDATE
+11 IF 'NOW
IF Y>0
Begin DoDot:1
+12 SET SAVEY=Y
+13 DO DD^%DT
+14 SET X=Y
+15 SET Y=SAVEY
End DoDot:1
ASK WRITE !!,"Task will be queued to run "_$SELECT(NOW:"NOW",1:X)_" Is that correct? :"
+1 READ XX:300
if '$TEST
SET XX="Y"
IF XX'="Y"
IF XX'="y"
IF XX'="N"
IF XX'="n"
WRITE " Enter Y or N"
GOTO ASK
+2 IF XX'="Y"
IF XX'="y"
GOTO GETDATE
+3 IF Y>0
IF ZTDTH=""
SET ZTDTH=Y
+4 IF ZTDTH=""
SET ZTDTH=$HOROLOG
+5 QUIT
+6 ;
SITE ; SET UP VARIABLES NEEDED BY BILLING
+1 SET PSOSITE=$SELECT(YY=0:$PIECE(^PSRX(RXP,2),"^",9),1:$PIECE($GET(^PSRX(RXP,1,YY,0)),"^",9))
+2 IF PSOSITE=""
QUIT
+3 SET PSOPAR=$GET(^PS(59,PSOSITE,1))
+4 SET PSOSITE7=$PIECE($GET(^PS(59,PSOSITE,"IB")),"^")
+5 QUIT
+6 ;
PATCHDT ; SHOW USER WHEN CMOP PATCH WAS FIRST INSTALLED
+1 ; DEFAULT FOR WHEN FIRST SITE INSTALLED THE PATCH
SET PSOFIRST="Oct 12, 2001"
+2 SET PSOINST=$ORDER(^XPD(9.7,"B","PSX*2.0*35",""))
IF PSOINST'=""
SET Y=$PIECE($GET(^XPD(9.7,PSOINST,1)),"^",3)
DO DD^%DT
SET PSOFIRST=Y
+3 WRITE !,"CMOP patch PSX*2*35 was first installed at your facility on ",PSOFIRST
+4 QUIT
+5 ;
CHKSITE ; SEE IF ANY DIVISIONS HAD THE PROBLEM
+1 SET PROBTEXT="'BARCODES ON ACTION PROFILES'"
+2 NEW SITE,PROB
+3 SET PROB=0
+4 SET SITE=""
FOR
SET SITE=$ORDER(^PS(59,SITE))
if SITE=""
QUIT
IF '$PIECE($GET(^PS(59,SITE,1)),"^",1)
Begin DoDot:1
+5 WRITE !!,"The Outpatient Site (File #59) parameter, "_PROBTEXT
+6 WRITE !,"for one or more outpatient sites is either not defined or set to 'No'."
+7 WRITE !,"All copay eligible, released CMOP prescription fills from those outpatient"
+8 WRITE !,"sites would not have been billed since the installation of PSX*2*35."
+9 WRITE !!,"NOTE: If the estimated number of CMOP prescriptions involved is high based"
+10 WRITE !,"on when the patch was first installed and the number of outpatient sites "
+11 WRITE !,"involved, you may want to disable journaling for Integrated Billing and"
+12 WRITE !,"Accounts Receivable globals ^IB and ^PRCA while the clean up job"
+13 WRITE !,"is running."
End DoDot:1
SET PROB=1
QUIT
+14 WRITE !!,"When the background job is complete, a MailMan message will be sent to the"
+15 WRITE !,"installer indicating how many copay eligible CMOP prescription fills were "
+16 WRITE !,"successfully billed."
+17 IF PROB
QUIT
+18 WRITE !!,"All "_PROBTEXT_" are set to 'YES' for all divisions."
+19 WRITE !,"The MailMan message at the end should indicate that no fills were found to"
+20 WRITE !,"reprocess. (i.e. All released CMOP fills have already been billed.)"
+21 QUIT
+22 ;
