source: FOIAVistA/tag/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCR02.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1BPSSCR02 ;BHAM ISC/SS - USER SCREEN UTILITIES ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,3**;JUN 2004;Build 20
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;USER SCREEN
5 Q
6REVERSE ;
7 N BPSDFN,BPSRX
8 D SELECT(.BPSDFN,.BPSRX)
9 S VALMBCK="R"
10 Q
11 ;
12SELECT(BPSDFN1,BPSRX1,BPSRF1,BPS59) ; Select a patient. Returns patient IEN(s) in array
13 N BPLN
14 S BPLN=$$SELLINE("Select the line(s) with the paid claim(s) you wish to REVERSE","")
15 Q
16 ;
17SELLINE(BPSPROM,BPSDFVL) ;
18 N BPRET,DIR,X,Y,DIRUT
19 S BPRET="^"
20 W ! S DIR(0)="N^::2",DIR("A")=BPSPROM,DIR("B")=BPSDFVL D ^DIR I $D(DIRUT) Q "^"
21 S $P(BPRET,U)=Y
22 Q BPRET
23 ;/**
24 ;make array element
25 ;BPLINE - line number in LM ARRAY (by ref)
26 ;BPTMP - VALMAR (TMP global for LM)
27 ;BP59 - ptr to 9002313.59
28 ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
29 ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
30 ;TMP structure gives on the screen:
31 ;^TMP("BPSSCR",$J,"VALM","LMIND",1,0,DFN,0,0)=
32 ;^TMP("BPSSCR",$J,"VALM",1,0)=1 BUMSTEAD,CHARLE (5444)/100-234-2345 *done* FINISHED
33 ;BPLINE = 1
34 ;BPLMIND=1
35 ;on the screen:
36 ;1 BUMSTEAD,CHARLE (5444) /100-234-2345 *done* FINISHED
37 ;
38 ;^TMP(538978189,"BPSSCR","SORT","T",1,401959.00001)=
39 ;^TMP("BPSSCR",$J,"VALM","LMIND",1,1,DFN,401959.00001,1)=
40 ;^TMP("BPSSCR",$J,"VALM",2,0)= 1.1 LOVASTATIN 20MG TAB
41 ;BPLINE = 2
42 ;BP59= 401959.00001
43 ;on the screen:
44 ; 1.1 LOVASTATIN 20MG TAB
45 ;
46 ;^TMP(538978189,"BPSSCR","SORT","T",1,501750.00011)=
47 ;^TMP("BPSSCR",$J,"VALM","LMIND",1,2,DFN,501750.00011,2)=
48 ;^TMP("BPSSCR",$J,"VALM",3,0)= 1.2 CIMETIDINE 300MG TAB
49 ;BPLINE = 3
50 ;BP59= 501750.00011
51 ;on the screen:
52 ; 1.2 CIMETIDINE 300MG TAB
53 ;
54MKARRELM(BPLINE,BPTMP,BP59,BPLMIND,BPDRIND,BPPREV) ;*/
55 N BPSSTR,BPLNS,BPDFN,BPSTAT,BPSINSUR,BPINSDAT
56 S BPDFN=+$P($G(^BPST(BP59,0)),U,6) ;patient's DFN
57 S BPINSDAT=$$GETINSUR^BPSSCRU2(BP59)
58 S BPSINSUR=+BPINSDAT ;patient's insurance IEN
59 ;
60 ;PATIENT SUMMARY level
61 ; if last one was different DFN/INSURANCE combination then create a new Patient Summary level
62 I (+$O(@BPTMP@("LMIND",BPLMIND,0,0))'=BPDFN)!(+$O(@BPTMP@("LMIND",BPLMIND,0,BPDFN,0))'=BPSINSUR) D
63 . ;-------- first process previous patient & insurance group
64 . ;determine patient summary statuses for the previous "patient" group
65 . I BPLMIND>0,+BPPREV=BPLMIND D
66 . . ;update the record for previous patient summary after we went thru all his claims
67 . . D UPDPREV(BPTMP,BPLMIND,BPPREV)
68 . ;process new "patient & insurance" group ------------------
69 . S BPDRIND=0
70 . S BPLMIND=(BPLMIND\1)+1
71 . ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
72 . S BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF(BPDFN,BPINSDAT)_U_BPSINSUR
73 . S BPSSTR=$$LJ(BPLMIND,4)_$P(BPPREV,U,4)
74 . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,BPSINSUR)
75 . S BPLINE=BPLINE+1
76 ;
77 ;CLAIMS level
78 D
79 . I +$O(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59 D
80 . . S BPDRIND=BPDRIND+1
81 . . S BPSSTR=" "_$$LJ(+$P(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF(BP59)
82 . . ;@debug,remove the next line after finish debugging
83 . . ;S BPSSTR=BPSSTR_" 59:"_BP59_" DT:"_$$TRANDT^BPSSCRU2(BP59)_" DFN:"_BPDFN_" INS:"_BPSINSUR
84 . . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
85 . . S BPLINE=BPLINE+1
86 . . N BPARR,X
87 . . S BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"R")
88 . . F X=1:1:BPLNS D
89 . . . I $G(BPARR(X))="" Q
90 . . . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
91 . . . S BPLINE=BPLINE+1
92 Q
93 ;S BPS=BPX
94 ;/**
95 ;BP59
96CLAIMINF(BP59) ;*/
97 N BPX,BPX1
98 S BPX1=$$RXREF^BPSSCRU2(BP59)
99 ;S BPX=BP59_$$LJ($$DRGNAME^BPSSCRU2(BP59),22)_" "_$$LJ($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),13)_" "
100 S BPX=$$LJ($$DRGNAME^BPSSCRU2(BP59),17)_" "_$$LJ($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),13)_" "
101 S BPX=BPX_$$LJ($$FILLDATE^BPSSCRRS(+BPX1,+$P(BPX1,U,2)),5)_" "
102 S BPX=BPX_$$LJ($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/"
103 S BPX=BPX_$$LJ($$ECMENUM^BPSSCRU2(BP59),7)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" "
104 S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59)
105 Q BPX
106 ;/**
107 ;determine "done" and "FINISHED" status for patient/insurance group by BPLMIND in TMP global
108STAT4PAT(BPLMIND) ;*/
109 N BPCL,BPDFN,BP59,BPX,BPINS,BPX,BPCNT
110 N BPPB,BPRJ,BPACRV,BPRJRV,BPSR,BPFIN,BPPRCNTG
111 S (BPCL,BPPB,BPRJ,BPACRV,BPSR,BPRJRV)=0
112 S BPFIN=0 ; finished by default
113 S BPPRCNTG=0
114 S BPCNT=0
115 F S BPCL=+$O(@BPTMP@("LMIND",BPLMIND,BPCL)) Q:BPCL=0 D
116 . S BPDFN=0
117 . F S BPDFN=+$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN)) Q:BPDFN=0 D
118 . . S BPINS="" ;can be 0 in the TMP global if insurance plan
119 . . ;is corrupted in file ##9002313.59
120 . . F S BPINS=$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS)) Q:BPINS="" D
121 . . . S BP59=0,BPINS=+BPINS
122 . . . F S BP59=+$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS,BP59)) Q:BP59=0 D
123 . . . . S BPCNT=BPCNT+1
124 . . . . S BPX=$P($$CLAIMST^BPSSCRU3(BP59),U)
125 . . . . I BPX["E PAYABLE" S BPPB=BPPB+1 ;Payable
126 . . . . I BPX["E REJECTED" S BPRJ=BPRJ+1 ;Rejected
127 . . . . I BPX["E REVERSAL ACCEPTED" S BPACRV=BPACRV+1 ;Accepted Reversal
128 . . . . I BPX["E REVERSAL REJECTED" S BPRJRV=BPRJRV+1 ;Rejected Reversal
129 . . . . ;don't count Auto-Reversal
130 . . . . ;I BPX["^SR^" S BPSR=BPSR+1 ; stranded
131 . . . . S BPFIN=BPFIN+$$PRCNTG^BPSSCRU3(BP59)
132 . . . . ;I BPFIN=1 Q "**FINISHED**"
133 ;Q BPCNT_" "_BPPB_","_BPRJ_","_BPACRV_","_BPSR
134 I BPCNT>0 S BPPRCNTG=(BPFIN/BPCNT)\1
135 I BPPRCNTG=99 S BPPRCNTG="Done"
136 E S BPPRCNTG=BPPRCNTG_"%"
137 S BPX="*"_BPPRCNTG_"*"
138 I BPPB=BPCNT S BPX=BPX_" ALL payable"
139 E S BPX=BPX_" Pb:"_BPPB_" Rj:"_BPRJ_" AcRv:"_BPACRV_" RjRv:"_BPRJRV
140 Q BPX
141 ;/**
142 ;gets the patient summary information
143 ;input:
144 ; BPDFN - ptr to #2
145 ; BPINS - insurance ien^insurance name^phone
146 ;output:
147 ; patient summary information
148PATINF(BPDFN,BPINS) ;*/
149 N X,BPINSNM
150 S BPINSNM=$P(BPINS,U,2)
151 S X=$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN),13) ;name
152 S X=X_" "_$$LJ($$SSN4^BPSSCRU2(BPDFN),6) ;4digits of SSN
153 S X=X_" "_$$LJ($S(BPINSNM="":"????",1:BPINSNM),8) ;insurance
154 S X=X_"/"_$$LJ($P(BPINS,U,3),14) ;phone
155 Q X
156 ;
157 ;/**
158 ;creates an entry in LM array and builds a non-standard index
159 ;BPLMIND - passed by ref - current LM index - patient_AND_insurance level
160 ;BPDRIND - passed by ref - current LM index - claim level
161 ;BPTMP - VALMAR (TMP global for LM)
162 ;BP59 - ptr to 9002313.59
163 ;BPLINE - line number in LM ARRAY (by ref)
164 ;BPSTR - string to save in ARRAY
165 ;BPSINSUR - INSURANCE ien
166SAVEARR(BPTMP1,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR) ;
167 S @BPTMP1@("LMIND",BPLMIND,BPDRIND,BPDFN,BPSINSUR,BP59,BPLINE)=""
168 D SET^VALM10(BPLINE,BPSSTR,BP59)
169 Q
170 ;left justified, blank padded
171 ;adds spaces on right or truncates to make return string BPLEN characters long
172 ;BPST- original string
173 ;BPLEN - desired length
174LJ(BPST,BPLEN) ;
175 N BPL
176 S BPL=BPLEN-$L(BPST)
177 Q $E(BPST_$J("",$S(BPL<0:0,1:BPL)),1,BPLEN)
178 ;
179 ;right justified, blank padded
180 ;adds spaces on left or truncates to make return string BPLEN characters long
181 ;BPST- original string
182 ;BPLEN - desired length
183RJ(BPST,BPLEN) ;
184 S BPL=BPLEN-$L(BPST)
185 I BPL>0 Q $J("",$S(BPL<0:0,1:BPL))_BPST
186 Q $E(BPST,1,BPLEN)
187 ;
188 ;is the claim payable?
189PAYABLE(BP59) ;
190 I $P($$CLAIMST^BPSSCRU3(BP59),U)["E PAYABLE" Q 1
191 Q 0
192 ;
193 ;is the claim rejected?
194REJECTED(BP59) ;
195 I $P($$CLAIMST^BPSSCRU3(BP59),U)["E REJECTED" Q 1
196 I $P($$CLAIMST^BPSSCRU3(BP59),U)["E REVERSAL REJECTED" Q 1
197 Q 0
198 ;update patient summary information for the previous patient/insurance pair
199UPDPREV(BPTMP,BPLMIND,BPPREV) ;
200 N BPSSTR
201 ;update the record for previous patient summary after we went thru all his claims
202 S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
203 D SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$P(BPPREV,U,3),0,+$P(BPPREV,U,2),BPSSTR,+$P(BPPREV,U,5))
204 Q
205 ;
Note: See TracBrowser for help on using the repository browser.