| 1 | IBCIMG ;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.
|
---|
| 21 | EN ; -- main entry point
|
---|
| 22 | D EN^VALM("IBCI CLAIMSMANAGER MGR WK")
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | HDR ; -- 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 | ;
|
---|
| 41 | INIT ; -- 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 | ;
|
---|
| 49 | HELP ; -- help code
|
---|
| 50 | S X="?" D DISP^XQORM1 W !!
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|
| 53 | EXIT ; -- 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 | ;
|
---|
| 65 | BLD ; 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 | ;
|
---|
| 146 | SETO(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 | ;
|
---|
| 151 | SET(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 | ;
|
---|
| 157 | SET1(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
|
---|
| 162 | CBILL ;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
|
---|
| 171 | EBILL ; 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
|
---|
| 176 | ABILL ; 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
|
---|
| 192 | XIT ;
|
---|
| 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 | ;
|
---|
| 201 | UTIL2 ;
|
---|
| 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
|
---|