source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCPIBF.m@ 1274

Last change on this file since 1274 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1PSOCPIBF ;BIR/EJW-Clean up to bill unbilled CMOP copays ;01/14/02
2 ;;7.0;OUTPATIENT PHARMACY;**93**;DEC 1997
3 ;External reference to ^XUSEC supported by DBIA 10076
4 ;External reference to ^XPD(9.7, supported by DBIA 2197
5 S ZTDTH=""
6 I $D(ZTQUEUED) S ZTDTH=$H
7 I ZTDTH="" D
8 .W !,"The background job to clean up unbilled, released CMOP prescription fills must"
9 .W !,"be queued to run and complete before 02/01/2002 when tracking for the "
10 .W !,"annual copay cap begins."
11 .W !!,"If no start date/time is entered when prompted, the background job will be "
12 .W !,"queued to run NOW."
13 .W !
14 .D PATCHDT
15 .D CHKSITE
16 .D GETDATE
17 .D BMES^XPDUTL("Queuing background job to reprocess unbilled copay CMOP Prescription fills...")
18 S ZTRTN="EN^PSOCPIBF",ZTIO="",ZTDESC="Background job to bill CMOP unbilled copays" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
19 W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
20 Q
21EN ;
22 N PSODATE,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND,PSOSTOP
23 S PSOCNT=0
24 S PSOSTOP=0
25 D NOW^%DTC S Y=% D DD^%DT S PSOSTART=Y
26 I '$G(DT) S DT=$$DT^XLFDT
27 I DT>3020201 S PSOSTOP=1 D MAIL Q ; TOO LATE TO RUN CLEAN-UP
28 S PSOINST=$O(^XPD(9.7,"B","PSX*2.0*35","")) I PSOINST'="" S PSODATE=$P($G(^XPD(9.7,PSOINST,1)),"^",3)
29 I $G(PSODATE)'="" S PSODATE=PSODATE-1
30 I $G(PSODATE)="" S PSODATE=3011011 ; DAY BEFORE PSX*2*35 WAS INSTALLED ANYWHERE
31 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
32 .S PSOIB=+$P($G(^PSRX(RXP,"IB")),"^") I 'PSOIB Q ; NOT MARKED AS A COPAY RX
33 . ; 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
34 .I 'YY D Q
35 ..I $P(^PSRX(RXP,"IB"),"^",2)'="" Q
36 ..D NOW^%DTC I %>3020201 S PSOSTOP=1 Q ; STOP IF REACH DATE OF COPAY RATE CHANGE
37 ..D SITE
38 ..I PSODATE>3011231 D CP^PSOCP
39 ..I PSODATE<3020101 D CP^PSOCPIBC ; BEFORE NEW EXEMPTION CHECKS WENT INTO EFFECT
40 ..I $P(^PSRX(RXP,"IB"),"^",2)'="" S PSOCNT=PSOCNT+1
41 .I $P($G(^PSRX(RXP,1,YY,"IB")),"^",1)="" D
42 ..D NOW^%DTC I %>3020201 S PSOSTOP=1 Q ; STOP IF REACH DATE OF COPAY RATE CHANGE
43 ..D SITE
44 ..I PSODATE>3011231 D CP^PSOCP
45 ..I PSODATE<3020101 D CP^PSOCPIBC ; BEFORE NEW EXEMPTION CHECKS WENT INTO EFFECT
46 ..I $P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" S PSOCNT=PSOCNT+1
47MAIL ;
48 D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
49 I $G(DUZ) S XMY(DUZ)=""
50 S XMDUZ="Outpatient Pharmacy",XMSUB="Outpatient Pharmacy Copay Clean-up"
51 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
52 I $O(XMY(""))="" Q ; no recipients for mail message
53 S PSOTEXT(1)="The Rx copay clean up job for the Outpatient Pharmacy patch (PSO*7*93)"
54 S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
55 I PSOCNT>0 S PSOTEXT(3)="Released unbilled copay Rxs have now been reprocessed."
56 I PSOCNT>0 S PSOTEXT(4)="There were "_PSOCNT_" Rx fills successfully billed."
57 I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay Rxs were found to reprocess."
58 I PSOSTOP D
59 .S PSOTEXT(5)=""
60 .S PSOTEXT(6)="PROCESSING CANNOT CONTINUE BEYOND JAN. 31,2002 BECAUSE OF COPAY RATE CHANGE."
61 .I $G(PSODATE)'="" S Y=PSODATE D DD^%DT S PSOTEXT(7)="AT TIME JOB TERMINATED, RELEASE DATE BEING PROCESSED WAS "_Y
62 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
63 S:$D(ZTQUEUED) ZTREQ="@"
64 Q
65 ;
66GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
67 S ZTDTH=""
68 S NOW=0
69 D NOW^%DTC S (Y,TODAY)=% D DD^%DT
70 W !!,"Background job must be queued to start by "_$S(Y<3020131:"Jan 30, 2002 or before.",1:"Jan 31, 2002.")
71 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
72 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."
73 W !,"If this prompting is during patch installation, you will not see what you type."
74 W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue copay clean-up Job to run Date/Time: "
75 D ^%DT K %DT I $D(DTOUT)!(Y<0) W "Task will be queued to run NOW" S ZTDTH=$H,NOW=1
76 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
77 I 'NOW,Y>0 D
78 .S SAVEY=Y
79 .D DD^%DT
80 .S X=Y
81 .S Y=SAVEY
82ASK W !!,"Task will be queued to run "_$S(NOW:"NOW",1:X)_" Is that correct? :"
83 R XX:300 S:'$T XX="Y" I XX'="Y",XX'="y",XX'="N",XX'="n" W " Enter Y or N" G ASK
84 I XX'="Y",XX'="y" G GETDATE
85 I Y>0,ZTDTH="" S ZTDTH=Y
86 I ZTDTH="" S ZTDTH=$H
87 Q
88 ;
89SITE ; SET UP VARIABLES NEEDED BY BILLING
90 S PSOSITE=$S(YY=0:$P(^PSRX(RXP,2),"^",9),1:$P($G(^PSRX(RXP,1,YY,0)),"^",9))
91 I PSOSITE="" Q
92 S PSOPAR=$G(^PS(59,PSOSITE,1))
93 S PSOSITE7=$P($G(^PS(59,PSOSITE,"IB")),"^")
94 Q
95 ;
96PATCHDT ; SHOW USER WHEN CMOP PATCH WAS FIRST INSTALLED
97 S PSOFIRST="Oct 12, 2001" ; DEFAULT FOR WHEN FIRST SITE INSTALLED THE PATCH
98 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
99 W !,"CMOP patch PSX*2*35 was first installed at your facility on ",PSOFIRST
100 Q
101 ;
102CHKSITE ; SEE IF ANY DIVISIONS HAD THE PROBLEM
103 S PROBTEXT="'BARCODES ON ACTION PROFILES'"
104 N SITE,PROB
105 S PROB=0
106 S SITE="" F S SITE=$O(^PS(59,SITE)) Q:SITE="" I '$P($G(^PS(59,SITE,1)),"^",1) D S PROB=1 Q
107 .W !!,"The Outpatient Site (File #59) parameter, "_PROBTEXT
108 .W !,"for one or more outpatient sites is either not defined or set to 'No'."
109 .W !,"All copay eligible, released CMOP prescription fills from those outpatient"
110 .W !,"sites would not have been billed since the installation of PSX*2*35."
111 .W !!,"NOTE: If the estimated number of CMOP prescriptions involved is high based"
112 .W !,"on when the patch was first installed and the number of outpatient sites "
113 .W !,"involved, you may want to disable journaling for Integrated Billing and"
114 .W !,"Accounts Receivable globals ^IB and ^PRCA while the clean up job"
115 .W !,"is running."
116 W !!,"When the background job is complete, a MailMan message will be sent to the"
117 W !,"installer indicating how many copay eligible CMOP prescription fills were "
118 W !,"successfully billed."
119 I PROB Q
120 W !!,"All "_PROBTEXT_" are set to 'YES' for all divisions."
121 W !,"The MailMan message at the end should indicate that no fills were found to"
122 W !,"reprocess. (i.e. All released CMOP fills have already been billed.)"
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.