source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIMG.m@ 1000

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

initial load of WorldVistAEHR
File size: 7.1 KB
Line 
1IBCIMG ;DSI/JSR - IBCI CLAIMS MANAGER MGR WORKSHEET ;6-MAR-2001
2 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;; Program Description:
5 ; This routine is a ListManager routine invoked when the user is in
6 ; the bill edit screen. This is a hybrid routine used for 3 reasons:
7 ; 1) To define and display all ListManager Template data with
8 ; aesthetic consistency.
9 ; 2) To permit Overriding Access for override CM errors.
10 ; 3) To Define and display MailMan header claims specific
11 ; information
12 ; IBCIMG is the main routine utilized when calling all 3 ListManager
13 ; templates. IBCIMG contains all the visual display details for all
14 ; LM templates and is also utilized for the building of MailMan
15 ; Messages.
16 ; Manager Access:
17 ; Is only permitted when IBCIMG security key action is
18 ; allocated for Manager Override access.
19 ; MailMan Messages:
20 ; Invoked by IBCIUT6 with a call to HDR^IBCIMG.
21EN ; -- main entry point
22 D EN^VALM("IBCI CLAIMSMANAGER MGR WK")
23 Q
24 ;
25HDR ; -- header code
26 S:'$D(IBCINAM) IBCINAM=IBCIPAD
27 S:'$D(IBCICLNO) IBCICLNO=IBCIPAD
28 S:'$D(IBCIBIR) IBCIBIR=IBCIPAD
29 S:'$D(IBCISEX) IBCISEX=IBCIPAD
30 S:'$D(IBCICNM) IBCICNM=IBCIPAD
31 S:'$D(IBCIASN) IBCIASN=IBCIPAD
32 S:'$D(IBCIBIL) IBCIBIL=IBCIPAD
33 S:'$D(IBCISRR) IBCISRR=IBCIPAD
34 S:'$D(IBCIEVV) IBCIEVV=IBCIPAD
35 S:'$D(IBCICAR) IBCICAR=IBCIPAD_IBCIPAD
36 S VALMHDR(1)=" Name: "_$E(IBCINAM,1,27)_"Sex: "_$E(IBCISEX,1)_" DOB: "_$E(IBCIBIR,1,11)_" Claim: "_$E(IBCICLNO,1,8)_"("_IBCISRR_")"
37 S VALMHDR(2)=" Ins: "_$E(IBCICAR,1,40)_" Provider: "_$E(IBCIPRV,1,16)
38 S VALMHDR(3)="Coder: "_$E(IBCICNM,1,16)_" Biller: "_$E(IBCIBIL,1,16)_" Assigned: "_$E(IBCIASN,1,16)
39 Q
40 ;
41INIT ; -- init variables and list array
42 S QUITDP=0
43 K ^TMP("IBCIMG",$J),^TMP("IBCIMG1",$J)
44 S IBCICMP=""
45 F I=1:1:50 S IBCICMP=IBCICMP_" "
46 D BLD
47 Q
48 ;
49HELP ; -- help code
50 S X="?" D DISP^XQORM1 W !!
51 Q
52 ;
53EXIT ; -- exit code
54 ; User is prompted to enter comments for each claim that has error if
55 ; they exit before fixing the claim.
56 I ($G(Y)="Q")!($G(Y)=-1) D
57 . D UTIL2
58 . I Y'=1 S QUITDP=1 Q
59 . D CLEAR^VALM1,CLEAN^VALM10
60 . D COMMENT^IBCIUT7(IBIFN,1)
61 K ^TMP("IBCILM",$J)
62 K ^TMP("IBCIMG",$J),^TMP("IBCIMG1",$J)
63 Q
64 ;
65BLD ; build array for display
66 N IBRT,IBCISEQ,IBCICNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE
67 N ICDL,ICDSP,ICDXX,LMDX,LMDX2,MODS,MOD2,EOLM
68 S (IBCICNT,VALMCNT)=1
69 S IBPREV=""
70 S IBTC(1)=1,IBTC(2)=30,IBTW(1)=1,IBTW(2)=10,IBSW(1)=79,IBSW(2)=12
71 ; create LM display array
72 S IBCIERL=0 F S IBCIERL=$O(^TMP("IBCILM",$J,IBCIERL)) Q:'IBCIERL D
73 . S YARR=""
74 . S IBCIZZZ=^TMP("IBCILM",$J,IBCIERL,0)
75 . S IBCIYYY=$TR(IBCIZZZ,"~","^")
76 . S TYPE=$P($G(IBCIYYY),U,1)
77 . S IBLINE=$P($G(IBCIYYY),U,2)
78 . S IBCILEV=$P($G(IBCIYYY),U,3)
79 . I IBLINE'=IBPREV D
80 .. S LMLINE="Line: "_IBLINE
81 .. S IBCILD1=$G(^IBA(351.9,IBIFN,5,IBLINE,0))
82 .. S IBCILD2=$G(^IBA(351.9,IBIFN,5,IBLINE,2))
83 .. S LMBDATE=$P($G(IBCILD1),U,6)
84 .. S LMEDATE=$P($G(IBCILD1),U,7)
85 .. S LMPOS=$P($G(IBCILD1),U,8)
86 .. S LMTOS=$P($G(IBCILD2),U,11)
87 .. S LMUNIT=$P($G(IBCILD2),U,12)
88 .. S LMCPT=$P($G(IBCILD1),U,9)
89 .. S LMCHARG=$P($G(IBCILD1),U,11)
90 .. S MODS=$TR($P($G(^IBA(351.9,IBIFN,5,IBLINE,3)),U,1),",","")
91 .. S LMMOD=$E(MODS,1,6)
92 .. S MOD2=$E(MODS,7,14)
93 .. S YARR=$$SETFLD^VALM1(LMTOS,YARR,"TOS")
94 .. S YARR=$$SETFLD^VALM1(LMPOS,YARR,"POS")
95 .. S YARR=$$SETFLD^VALM1(($E(LMBDATE,5,6)_"/"_$E(LMBDATE,7,8)_"/"_$E(LMBDATE,1,4)),YARR,"BDATE")
96 .. S YARR=$$SETFLD^VALM1(($E(LMEDATE,5,6)_"/"_$E(LMEDATE,7,8)_"/"_$E(LMEDATE,1,4)),YARR,"EDATE")
97 .. S YARR=$$SETFLD^VALM1($J($FN(LMCHARG,"",2),7),YARR,"CHARGE") ;JSR 6/22/2001 Number Format fix
98 .. S YARR=$$SETFLD^VALM1(LMCPT,YARR,"CPT")
99 .. S YARR=$$SETFLD^VALM1(LMMOD,YARR,"MODIFY")
100 .. S YARR=$$SETFLD^VALM1(LMUNIT,YARR,"UNITS")
101 .. S YARR=$$SETFLD^VALM1(LMLINE,YARR,"LINE")
102 .. I IBCICNT'=1 S IBT="",IBD="" S IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
103 .. S IBT="",IBD=YARR S IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
104 .. D CNTRL^VALM10((IBCICNT-1),1,79,IOINHI,IOINORM)
105 .. ; ******
106 .. D DIAG^IBCIUT1(IBIFN)
107 .. S ICDXX=""
108 .. S ICDSP=""
109 .. S ICDL=""
110 .. F S ICDL=$O(^TMP("DISPLAY",$J,IBIFN,"ICD",IBLINE,ICDL)) Q:ICDL="" D
111 ... S ICDXX=ICDXX_ICDSP_^TMP("DISPLAY",$J,IBIFN,"ICD",IBLINE,ICDL)
112 ... S ICDSP=" / "
113 .. S LMDX=" Dx's: "
114 .. S LMDX2=ICDXX
115 .. ;
116 .. ; esg - 10/26/01 - squeeze in 4th thru 7th modifiers on the 2nd line
117 .. I $L(ICDXX)<46,MOD2'="" S LMDX2=ICDXX_$J("",47-$L(ICDXX))_MOD2
118 .. S IBLR=1
119 .. S IBT=$E(LMDX,1,60),IBD=LMDX2 S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
120 .. D CNTRL^VALM10((IBCICNT-1),1,79,IOINHI,IOINORM)
121 .. ; *****
122 .. S IBGRPB=IBCICNT
123 . I IBLINE=IBPREV D
124 .. S IBGRPB=IBCICNT,IBLR=1
125 .. S IBT="",IBD="" S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
126 . S IBGRPB=IBCICNT,IBLR=1
127 . S IBPREV=IBLINE
128 . S IBCISEQ=0 F S IBCISEQ=$O(^TMP("IBCILM",$J,IBCIERL,IBCISEQ)) Q:'IBCISEQ D
129 .. S IBCICM2="Error Level: "_IBCILEV
130 .. S IBCICM1="("_IBCIERL_") "_"ClaimsManager Error: "_TYPE_IBCICMP
131 .. S IBT=$E(IBCICM1,1,60),IBD=IBCICM2 S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
132 .. S IBCIERT=0 F S IBCIERT=$O(^TMP("IBCILM",$J,IBCIERL,IBCISEQ,IBCIERT)) Q:'IBCIERT D
133 ... S IBGRPB=IBCICNT,IBLR=1
134 ... S DATA=$G(^TMP("IBCILM",$J,IBCIERL,IBCISEQ,IBCIERT,0))
135 ... S IBT=" ",IBD=DATA S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
136 ... S IBGRPE=IBCICNT,IBCICNT=IBGRPB,IBLR=2
137 ... S (IBCICNT,VALMCNT)=$S(IBCICNT>IBGRPE:IBCICNT,1:IBGRPE)
138 F I=1:1:5 S IBT="",IBD="" S IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
139 S EOLM=IBCICNT-7
140 ;
141 I EOLM=-1 S IBCICNT=$$SET(" ","",1,1),IBCICNT=$$SET("No ERRORS defined for claim EVENT DATE: "_IBCIEVV,"",2,1),VALMSG="No Errors found by ClaimsManager."
142 ;
143 K ^TMP("DISPLAY",$J) ; This is the arrary for the dx & line assoc.
144 Q
145 ;
146SETO(RT,LN) ;
147 ; set line number of beginning line of ClaimsManager error message
148 S ^TMP("IBCIMG1",$J,+$G(RT))=+$G(LN)
149 Q
150 ;
151SET(TTL,DATA,LN,LR) ;
152 N IBY
153 S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
154 S LN=LN+1
155 Q LN
156 ;
157SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
158 N IBX S IBX=$G(^TMP("IBCIMG",$J,LN,0))
159 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
160 D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
161 Q
162CBILL ;Cancel Bill
163 ; Uses core IB and takes user cancel and populates Comment
164 D CLEAR^VALM1
165 N IBQUIT,IBCCCC,I,IBCICNCL
166 S IBCICNCL=1
167 D PROCESS^IBCC(IBIFN) I IBQUIT=1 S VALMBCK="R" Q
168 S VALMBCK="Q"
169 K ^TMP("IBCILM",$J)
170 Q
171EBILL ; re-edit action no need to capture comments
172 ; Uses core IB routines and allows user to re-edit bill
173 D CLEAR^VALM1,CLEAN^VALM10
174 S IBCIREDT=1
175 Q
176ABILL ; override action
177 ; This Protocol driven option only appears for those user witht he override key
178 N IBCISNT
179 S VALMBCK="R"
180 S DIR(0)="Y"
181 S DIR("A")="Are you sure you want to Override the errors of this bill"
182 S DIR("B")="YES"
183 D ^DIR K DIR
184 Q:$D(DIRUT)
185 I Y'=1 Q
186 S VALMBCK="Q"
187 D CLEAR^VALM1,CLEAN^VALM10
188 S IBCISNT=5
189 D ST2^IBCIST
190 D COMMENT^IBCIUT7(IBIFN,2)
191 Q
192XIT ;
193 S VALMBCK="R"
194 D UTIL2
195 I Y'=1 Q
196 S VALMBCK="Q"
197 D CLEAR^VALM1,CLEAN^VALM10
198 D COMMENT^IBCIUT7(IBIFN,1)
199 Q
200 ;
201UTIL2 ;
202 S DIR(0)="Y"
203 S DIR("A")="Are you sure you want to Exit the ClaimsManager Interface process"
204 S DIR("B")="YES"
205 D ^DIR K DIR
206 I $D(DIRUT) S Y=1
207 K DIRUT
208 Q
Note: See TracBrowser for help on using the repository browser.