source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSBCKJ.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1BPSBCKJ ;BHAM ISC/AAT - BPS NIGHTLY BACKGROUND JOB ;02/27/2005
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7EN ; The ECME NIGHTLY PROCESS
8 ;
9 ; The list of nightly actions
10 D AUTOREV ; Auto-Reversals (normal and inpatient)
11 D MAIN^BPSOSK ; Purge BPS LOG
12 D TASKMAN^BPSJAREG ; Do automatic registration.
13 Q
14 ;
15AUTOREV ; The Auto-Reverse Procedure
16 N BDT,BTRAN,BPHARM,BTRAN0,BTRAN1,BTRAN4,BDAYS,BRX,BFIL,BDATE,BNOW,BCLAIM,BRES,BREV,BTEST,REF,BCNT,BTX,X,X1,X2
17 ;
18 S BTEST=0 ; Debugging flag 1 - TEST, 0 - LIVE
19 S BCNT=0 ; Count reversals
20 ;
21 S REF=$NA(^TMP($J,"BPSBCKJ")) K @REF
22 ;
23 S (X1,BNOW)=$$DT^XLFDT()
24 ;
25 ;Define number of days to look back - Auto Reverse days can be from 0-31
26 ;To make sure every claim is caught, moving back 45 days
27 S X2=-45 D C^%DTC S BDT=X
28 ;
29 ;Loop through 'LAST UPDATE' 'AH' index
30 F S BDT=$O(^BPST("AH",BDT)) Q:'BDT S BTRAN=0 F S BTRAN=$O(^BPST("AH",BDT,BTRAN)) Q:'BTRAN D
31 . W:BTEST !,"TRAN=",BTRAN," ",?20
32 . S BTRAN0=$G(^BPST(BTRAN,0)),BTRAN1=$G(^(1)),BTRAN4=$G(^(4))
33 . I BTRAN0=""!(BTRAN1="") W:BTEST "ZERO OR ONE NODE MISSING" Q
34 . I '$$PAID^BPSOSQ4(BTRAN) W:BTEST "NOT PAID" Q ; Not paid
35 . S BPHARM=$P(BTRAN1,U,7) I 'BPHARM W:BTEST "NO BPS PHARM" Q ; BPS PHARMACY
36 . W:BTEST "BPHARM=",$P($G(^BPS(9002313.56,BPHARM,0)),U,1)," "
37 . ;
38 . ;Handle 'Inpatient' Auto-Reversals
39 . S BREV=$$REVINP(BNOW,BTRAN,BTRAN0,BTRAN1,BPHARM) Q:BREV
40 . ;
41 . ;Handle Regular Auto-Reversals
42 . S BDAYS=+$P($G(^BPS(9002313.56,BPHARM,0)),U,9)
43 . I 'BDAYS W:BTEST "AUTO-REV DISABLED" Q ;disabled
44 . I $P(BTRAN4,U,1) Q ;Reversal claim exist
45 . S BCLAIM=$P(BTRAN0,U,4) I 'BCLAIM W:BTEST "NO BCLAIM" Q
46 . I $P($G(^BPSC(BCLAIM,0)),U,7) W:BTEST "AUTO-REVERSE FLAG" Q
47 . S BDATE=$P($G(^BPSC(BCLAIM,0)),U,5)
48 . I 'BDATE S BDATE=$P($G(^BPSC(BCLAIM,0)),U,6)
49 . S BDATE=$P(BDATE,".")
50 . I 'BDATE="" W:BTEST "NO DATE" Q
51 . W:BTEST "DATE=",BDATE," "
52 . I $$FMDIFF^XLFDT(BNOW,BDATE,1)'>BDAYS W:BTEST "TOO EARLY" Q
53 . S BRX=$P(BTRAN1,U,11) I 'BRX W:BTEST "NO RX" Q
54 . S BFIL=$P(BTRAN1,U,1)
55 . I $$RELDATE(BRX,BFIL) W:BTEST " RELEASED" Q ;released
56 . S BRES=$$REVERSE(BRX,BFIL,BCLAIM,1)
57 . W:BTEST " *REV CLM=",BCLAIM," STAT=",BRES
58 . I BRES=0!(BRES=4) D
59 .. S (BCNT,@REF@(BRES))=$G(@REF@(BRES))+1
60 .. S @REF@(BRES,BCNT)=BTRAN_U_BCLAIM_U_BRX_U_BFIL_U_BPHARM
61 . ; Any notifications to IB?
62 D BULL(REF) ; Send the bulletin
63 K @REF
64 Q
65 ;
66 ;Auto-Reverse Claims for Current Inpatients
67 ;
68 ;20050810;BEE;Phase III - CR11
69 ;
70REVINP(BNOW,BTRAN,BTRAN0,BTRAN1,BPHARM) ;
71 N BRX,BFIL,BCLAIM,BDATE,BRES,DFN,VAIP
72 ;
73 ;Only process Window fills
74 S BRX=+$P(BTRAN1,U,11) I BRX=0 Q 0
75 S BFIL=+$P(BTRAN1,U)
76 I $$MWC^BPSRPT6(BRX,BFIL)'="W" Q 0
77 ;
78 ;Check for Fill date - Must be equal to T-5
79 S BCLAIM=$P(BTRAN0,U,4) I 'BCLAIM Q 0
80 S BDATE=$$FILDATE(BRX,BFIL)
81 S BDATE=$P(BDATE,".")
82 I 'BDATE="" Q 0
83 I $$FMDIFF^XLFDT(BNOW,BDATE,1)'=5 Q 0
84 ;
85 ;Check for current Inpatient
86 S DFN=+$P(BTRAN0,U,6) I DFN=0 Q 0
87 D IN5^VADPT
88 I $G(VAIP(3))="" Q 0
89 ;
90 ;Auto-Reverse Claim
91 S BRES=$$REVERSE(BRX,BFIL,BCLAIM,2)
92 W:BTEST " *REV CLM=",BCLAIM," STAT=",BRES
93 I BRES=0!(BRES=4) D
94 . S (BCNT,@REF@(BRES))=$G(@REF@(BRES))+1
95 . S @REF@(BRES,BCNT)=BTRAN_U_BCLAIM_U_BRX_U_BFIL_U_BPHARM
96 Q 1
97 ;
98RELDATE(BRX,BFIL) ;Get the Released Date
99 I BFIL Q $$RXSUBF1^BPSUTIL1(BRX,52,52.1,+BFIL,17,"I")
100 Q $$RXAPI1^BPSUTIL1(BRX,31,"I")
101 ;
102FILDATE(BRX,BFIL) ;Get the Fill Date
103 I BFIL Q $$RXSUBF1^BPSUTIL1(BRX,52,52.1,+BFIL,.01,"I")
104 Q $$RXAPI1^BPSUTIL1(BRX,22,"I")
105 ;
106REVERSE(BRX,BFIL,BCLAIM,BTYPE) ;Auto-Reverse the claim
107 ;PUBLIC BTEST
108 N BDOS,BRES,BDAT,BMES,BRSN
109 I $G(BTEST) Q 0 ; Test mode
110 ;
111 ; Get Date of Service and set reversal reason
112 S BDOS=$$DOSDATE^BPSSCRRS(BRX,BFIL)
113 S BRSN=$S(BTYPE=2:"CURRENT INPATIENT",1:"PRESCRIPTION NOT RELEASED")
114 ;
115 ; Call ECME to process reversal
116 S BRES=$$EN^BPSNCPDP(BRX,BFIL,BDOS,"AREV","",BRSN,"")
117 ;
118 ; If successful, log message to the Prescription Activity Log
119 ; and set the auto-reversal flag
120 S BRES=+BRES,BMES="Submitted to ECME: AUTO REVERSAL JOB"
121 I BRES=0 D
122 . D ECMEACT^PSOBPSU1(BRX,BFIL,BMES,.5)
123 . S BDAT(9002313.02,BCLAIM_",",.07)=BTYPE D FILE^DIE("","BDAT")
124 Q BRES
125 ;
126 ;
127BULL(REF) ;Bulletin to the OPECC
128 ;PUBLIC BTEST,DUZ,DT
129 N XMSUB,XMY,XMTEXT,XMDUZ,BLNUM
130 ;
131 S BLNUM=0,BCNT=+$G(@REF@(0))
132 S XMSUB="ECME AUTO-REVERSAL PROCESS"
133 I $G(BTEST) D T("*** P L E A S E D I S R E G A R D T H I S E M A I L ***"),T(),T("NOT ACTUALLY REVERSED - THIS IS A TEST"),T()
134 D T("The ECME Nightly Process submitted auto-reversals for the following e-Pharmacy")
135 D T("prescriptions.")
136 D T()
137 D T("TOTAL CLAIMS SUBMITTED FOR AUTO-REVERSALS: "_BCNT)
138 D T()
139 I BCNT D T("Claims Submitted for Auto-Reversals on "_$$DAT(DT)_":") D ARLIST(0,REF)
140 D T()
141 S BCNT=+$G(@REF@(4))
142 I BCNT'=0 D
143 . D T()
144 . D T("The ECME Nightly Process attempted to auto-reverse the following claims but")
145 . D T("could not because the previous request was IN PROGRESS. Please verify that")
146 . D T("the previous request is not stranded.")
147 . D T()
148 . D T("Total number of claims that could not be auto-reversed: "_BCNT)
149 . D T()
150 . D T("Claims not auto-reversed on "_$$DAT(DT)_":")
151 . D ARLIST(4,REF)
152 . D T()
153 ;
154 S XMDUZ="BPS PACKAGE",XMTEXT="BTX("
155 S XMY("G.BPS OPECC")=""
156 I $G(DUZ)'<1 S XMY(DUZ)=""
157 D ^XMD
158 Q
159 ;
160T(BTXT) ; Add text to the message
161 ;PUBLIC BLNUM,BTEST
162 S BLNUM=BLNUM+1,BTX(BLNUM)=$G(BTXT," ")
163 I $G(BTEST) W !,$G(BTXT)
164 Q
165 ;
166ARLIST(BRES,REF) ;Auto-Rev List
167 N I,TXT,BCLAIM,BTRAN,Y,BRX,BFIL,BFDATE,BPHARM,BRXN,BPHARMN,BPAT,BPSTAT
168 D T()
169 D T(" # RX FILL STATUS FILL DATE PATIENT BPS PHARMACY")
170 D T("------------------------------------------------------------------------------")
171 S I=0 F S I=$O(@REF@(BRES,I)) Q:'I D
172 . S Y=@REF@(BRES,I)
173 . S BTRAN=$P(Y,U)
174 . S BCLAIM=$P(Y,U,2)
175 . S BRX=$P(Y,U,3),BRXN=$$RXAPI1^BPSUTIL1(BRX,.01,"I")
176 . S BPAT=$P($G(^DPT(+$$RXAPI1^BPSUTIL1(BRX,2,"I"),0)),U)
177 . S BFIL=$P(Y,U,4)
178 . S BPHARM=$P(Y,U,5),BPHARMN=$P($G(^BPS(9002313.56,BPHARM,0)),U)
179 . S BFDATE=$$FILDATE(BRX,BFIL)
180 . S BPSTAT=$$MWC^BPSRPT6(BRX,BFIL)_"/"_$S($$RELDATE(BRX,BFIL)]"":"RL",1:"NR")
181 . S TXT=$J(I,3)_" "_$$J(BRXN,10)_" "_$$J(BFIL,2)_" "_$J(BPSTAT,4)_" "_$$J($$DAT(BFDATE),11)_$$J(BPAT,25)_" "_$J($E(BPHARMN,1,15),15)
182 . D T(TXT)
183 D T("------------------------------------------------------------------------------")
184 Q
185 ;
186J(TXT,LEN) ;Left justify
187 Q TXT_$J("",LEN-$L(TXT))
188 ;
189DAT(X,Y) ; Convert FM date to displayable (mm/dd/yy) format.
190 ; -- optional output of time, if $g(y)
191 N DATE,T
192 S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
193 I $G(Y) S T="."_$E($P(X,".",2)_"000000",1,7) I T>0 S DATE=DATE_" "_$S($E(T,2,3)>12:$E(T,2,3)-12,$E(T,2,3)="00":"00",1:+$E(T,2,3))_":"_$E(T,4,5)_$S($E(T,2,5)>1200:" pm",1:" am")
194 Q DATE
Note: See TracBrowser for help on using the repository browser.