source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCECSA1.m@ 636

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

WorldVistAEHR overlayed on FOIAVistA
File size: 6.2 KB
Line 
1IBCECSA1 ;ALB/CXW - IB STATUS AWAITING RESOLUTION SCREEN ;28-JUL-99
2 ;;2.0;INTEGRATED BILLING;**137,283,288,320**;21-MAR-94
3 ; DBIA for $$BN1^PRCAFN()
4 ;
5BLD ; Build list entrypoint
6 N IBDA,IBREV,IBIFN,IBPAY,IBSSN,IBSER,IB399,IBLOC,IBDIV,IBUER,IBMSG,IBERR,IBPEN,SEVERITY,A,IBOAM,IBPAT,IBSTSMSG,SV1,SV2,SV3
7 K ^TMP("IBCECSA",$J),^TMP("IBCECSB",$J),^TMP("IBCECSD",$J)
8 W !!,"Compiling CSA status messages ... "
9 S IBSEV=$G(IBSEV,"R")
10 S VALMCNT=0,IB364=""
11 S SEVERITY=""
12 F S SEVERITY=$O(^IBM(361,"ACSA",SEVERITY)) Q:SEVERITY="" I SEVERITY="R"!(IBSEV="B") S IBREV="" F S IBREV=$O(^IBM(361,"ACSA",SEVERITY,IBREV)) Q:IBREV="" I IBREV<2 S IBDA=0 F S IBDA=$O(^IBM(361,"ACSA",SEVERITY,IBREV,IBDA)) Q:'IBDA D
13 . S IB=$G(^IBM(361,IBDA,0)),IBIFN=+IB
14 . S IBPEN=$$FMDIFF^XLFDT(DT,$P(IB,U,2),1)
15 . ;quit if not pending for at least the minimum # of days requested
16 . Q:IBDAYS>IBPEN
17 . S IB399=$G(^DGCR(399,IBIFN,0))
18 . ;
19 . ; no cancelled claims allowed on the CSA screen
20 . ; if we find one, then update the appropriate EDI files
21 . I $P(IB399,U,13)=7 D UPDEDI^IBCEM(+$P(IB,U,11),"C") Q
22 . ;
23 . ; automatically review this message if the claim was last printed on
24 . ; or after the MCS - 'Resubmit by Print' date
25 . I $P(IB,U,16),($P($G(^DGCR(399,IBIFN,"S")),U,14)\1)'<$P(IB,U,16) D UPDEDI^IBCEM(+$P(IB,U,11),"P") Q
26 . ;
27 . S IBDIV=+$P(IB399,U,22)
28 . S IBUER=+$P($G(^DGCR(399,IBIFN,"S")),U,11)
29 . ;
30 . ; If Request MRA bill, pull the MRA Requestor user instead
31 . I 'IBUER,$P(IB399,U,13)=2 S IBUER=+$P($G(^DGCR(399,IBIFN,"S")),U,8)
32 . I $D(^TMP("IBBIL",$J)),'$D(^TMP("IBBIL",$J,IBUER)) Q ; User not selected
33 . I $D(^TMP("IBDIV",$J)),'$D(^TMP("IBDIV",$J,IBDIV)) Q ; Div not selected
34 . ;
35 . S IBPAY=$P($G(^DIC(36,+$P($G(^DGCR(399,IBIFN,"MP")),U),0)),U)
36 . I IBPAY="" S IBPAY=$P($G(^DIC(36,+$$CURR^IBCEF2(IBIFN),0)),U)
37 . I IBPAY="" S IBPAY="UNKNOWN PAYER"
38 . S IBPAT=$G(^DPT(+$P(IB399,U,2),0))
39 . S IBSSN=$E($P(IBPAT,U,9),6,9) I IBSSN="" S IBSSN="~unk"
40 . S IBPAT=$P(IBPAT,U,1) I IBPAT="" S IBPAT="~UNKNOWN PATIENT NAME"
41 . S IBSER=$P($G(^DGCR(399,IBIFN,"U")),U)
42 . S IBLOC=$P(IB399,U,4)
43 . S IBLOC=$S(IBLOC=1:"HOSPITAL",IBLOC=2:"SKILLED NURSING",1:"CLINIC")
44 . I IBDIV S IBDIV=$P($G(^DG(40.8,IBDIV,0)),U)
45 . I IBDIV=""!(IBDIV=0) S IBDIV="UNSPECIFIED"
46 . S IBMSG=$S($P(IB,U,8):"PAYER",1:"NON-PAYER")
47 . S IBUER=$S(IBUER:$P($G(^VA(200,IBUER,0)),U),1:"UNKNOWN")_"~"_IBUER
48 . S IB364=$P(IB,U,11)
49 . S IBOAM=$G(^DGCR(399,IBIFN,"U1"))
50 . S IBOAM=$P(IBOAM,U,1)-$P(IBOAM,U,2) ; current balance (total charges - offset)
51 . ;
52 . S IBSTSMSG=$$TXT(IBDA) ; status message text
53 . S IBERR=$E(IBSTSMSG,1,30)
54 . I IBERR="" S IBERR="-"
55 . ;
56 . S IB=$$BN1^PRCAFN(IBIFN) ; external bill#
57 . S A=IBIFN_U_IBPAY_U_IBPAT_U_IBSSN_U_IBSER_U_IBOAM_U_IBLOC_U_IBDIV_U_IBUER_U_IBMSG_U_IBPEN_U_$S(IBREV:"*",1:"")_U_IB364_U_IB
58 . ;
59 . S SV1=$$SRTV($G(IBSORT1),IBDA)
60 . S SV2=$$SRTV($G(IBSORT2),IBDA)
61 . S SV3=$$SRTV($G(IBSORT3),IBDA)
62 . S ^TMP("IBCECSB",$J,SV1,SV2,SV3,IBDA)=A
63 . S ^TMP("IBCECSB",$J,SV1,SV2,SV3,IBDA,"MSG")=IBSTSMSG
64 . Q
65 ;
66 I '$D(^TMP("IBCECSB",$J)) D NMAT Q
67 D SCRN
68 Q
69 ;
70NMAT ;No CSA list
71 S VALMCNT=2,IBCNT=2
72 S ^TMP("IBCECSA",$J,1,0)=" "
73 S ^TMP("IBCECSA",$J,2,0)="No Messages Matching Selection Criteria Found"
74 Q
75 ;
76SRTV(SORT,IBDA) ; sort value calculation given the sort code letter
77 I SORT="" Q IBDA
78 Q $$SV^IBCECSA(SORT)
79 ;
80SCRN ;
81 NEW IBSRT1,IBSRT2,IBSRT3,IBX,IBCNT,IBIFN,IBDA,IB,INFX,DAT,X
82 W !,"Building the CSA list display ... "
83 S IBCNT=0,IBSRT1=""
84 F S IBSRT1=$O(^TMP("IBCECSB",$J,IBSRT1)) Q:IBSRT1="" D
85 . D SRTBRK(1,$G(IBSORT1),IBSRT1)
86 . S IBSRT2=""
87 . F S IBSRT2=$O(^TMP("IBCECSB",$J,IBSRT1,IBSRT2)) Q:IBSRT2="" D
88 .. D SRTBRK(2,$G(IBSORT2),IBSRT2)
89 .. S IBSRT3=""
90 .. F S IBSRT3=$O(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3)) Q:IBSRT3="" D
91 ... D SRTBRK(3,$G(IBSORT3),IBSRT3)
92 ... S IBDA=0
93 ... F S IBDA=$O(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3,IBDA)) Q:'IBDA D
94 .... S IB=$G(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3,IBDA))
95 .... S IBSTSMSG=$G(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3,IBDA,"MSG"))
96 .... S IBIFN=+IB
97 .... S IB364=$P(IB,U,13)
98 .... S DAT=IBIFN_U_IBDA_U_IBSRT1_U_IBSRT2_U_IB364_U_IBSRT3
99 .... ;
100 .... S IBCNT=IBCNT+1
101 .... S X=$$SETFLD^VALM1($J(IBCNT,3),"","NUMBER")
102 .... D SETL1(IB,.X)
103 .... D SET(X,IBCNT,DAT)
104 .... ;
105 .... S X=$$SETSTR^VALM1(IBSTSMSG,"",6,75)
106 .... D SET(X,IBCNT,DAT)
107 .... Q
108 ... Q
109 .. Q
110 . Q
111 Q
112 ;
113SRTBRK(LVL,SORT,IBSRT) ; sort break for display of certain sort data
114 ; LVL - sort level
115 ; SORT - sort letter code
116 ; IBSRT - subscript data
117 ;
118 NEW IBS,DSPDATA
119 I '$F(".A.D.N.","."_$G(SORT)_".") G SRTBRKX
120 S IBS=$$SD^IBCECSA(SORT)
121 S DSPDATA=IBSRT
122 I SORT="A" S DSPDATA=$P(DSPDATA,"~",1) ; biller name
123 I SORT="N" S DSPDATA=-DSPDATA ; number of days pending
124 D SET($J("",LVL-1)_IBS_": "_DSPDATA,IBCNT,"")
125SRTBRKX ;
126 Q
127 ;
128SET(X,CNT,DAT) ;set up list manager screen array
129 S VALMCNT=VALMCNT+1
130 I 'CNT S CNT=1
131 S ^TMP("IBCECSA",$J,VALMCNT,0)=X
132 S ^TMP("IBCECSA",$J,"IDX",VALMCNT,CNT)=""
133 I DAT'="" S ^TMP("IBCECSA",$J,CNT)=VALMCNT_U_DAT
134 Q
135 ;
136SETL1(IB,X) ;
137 S X=$$SETFLD^VALM1($P($G(^DGCR(399,+IB,0)),U,1)_$P(IB,U,12),X,"BILL")
138 S X=$$SETFLD^VALM1($P(IB,U,2),X,"PNAME")
139 S X=$$SETFLD^VALM1($P(IB,U,3),X,"PANAME")
140 S X=$$SETFLD^VALM1($P(IB,U,4),X,"SSN")
141 S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB,U,5),"2Z"),X,"SERVICE")
142 S X=$$SETFLD^VALM1($J("$"_$FN($P(IB,U,6),"",2),10),X,"CURBAL")
143 Q
144 ;
145TXT(IBDA,LEN) ; Return a string of status message text
146 ; IBDA - ien to file 361
147 ; LEN - desired maximum length of combined text string
148 NEW MSG,LN,STOP,TX,HLN,REFN,DELIM
149 S MSG="",LN=0,LEN=$G(LEN,75),STOP=0
150 F S LN=$O(^IBM(361,+$G(IBDA),1,LN)) Q:'LN D Q:STOP
151 . S TX=$G(^IBM(361,IBDA,1,LN,0))
152 . I $E(TX,1,5)="Error" S TX=$E(TX,6,999)
153 . S TX=$$TRIM^XLFSTR(TX)
154 . I $E(TX,1,8)="Patient:" S STOP=1 Q
155 . I $E(TX,1,14)="Service Dates:" S STOP=1 Q
156 . I $E(TX,1,11)="Payer Name:" S STOP=1 Q
157 . I $E(TX,1,7)="Source:" S STOP=1 Q
158 . I $E(TX,1,11)="Claim Line:" S STOP=1 Q
159 . I $E(TX,1,13)="Service Type:" S STOP=1 Q
160 . I TX["HL=" S HLN=+$P(TX,"HL=",2),DELIM="HL="_HLN,TX=$P(TX,DELIM,1)_"HL= "_$P(TX,DELIM,2,9)
161 . I TX["ENVOY REF: " S REFN=$E($P(TX,"ENVOY REF: ",2),1,14),DELIM="ENVOY REF: "_REFN,TX=$P(TX,DELIM,1)_"ENVOY REF: "_$P(TX,DELIM,2,9)
162 . I ($L(MSG)+$L(TX))>500 S STOP=1 Q
163 . S MSG=MSG_$S(MSG="":"",1:" ")_TX
164 . I $L(MSG)>LEN S STOP=1
165 . Q
166 Q $E(MSG,1,LEN)
167 ;
Note: See TracBrowser for help on using the repository browser.