IBCIMG ;DSI/JSR - IBCI CLAIMS MANAGER MGR WORKSHEET ;6-MAR-2001
;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;; Program Description:
; This routine is a ListManager routine invoked when the user is in
; the bill edit screen. This is a hybrid routine used for 3 reasons:
; 1) To define and display all ListManager Template data with
; aesthetic consistency.
; 2) To permit Overriding Access for override CM errors.
; 3) To Define and display MailMan header claims specific
; information
; IBCIMG is the main routine utilized when calling all 3 ListManager
; templates. IBCIMG contains all the visual display details for all
; LM templates and is also utilized for the building of MailMan
; Messages.
; Manager Access:
; Is only permitted when IBCIMG security key action is
; allocated for Manager Override access.
; MailMan Messages:
; Invoked by IBCIUT6 with a call to HDR^IBCIMG.
EN ; -- main entry point
D EN^VALM("IBCI CLAIMSMANAGER MGR WK")
Q
;
HDR ; -- header code
S:'$D(IBCINAM) IBCINAM=IBCIPAD
S:'$D(IBCICLNO) IBCICLNO=IBCIPAD
S:'$D(IBCIBIR) IBCIBIR=IBCIPAD
S:'$D(IBCISEX) IBCISEX=IBCIPAD
S:'$D(IBCICNM) IBCICNM=IBCIPAD
S:'$D(IBCIASN) IBCIASN=IBCIPAD
S:'$D(IBCIBIL) IBCIBIL=IBCIPAD
S:'$D(IBCISRR) IBCISRR=IBCIPAD
S:'$D(IBCIEVV) IBCIEVV=IBCIPAD
S:'$D(IBCICAR) IBCICAR=IBCIPAD_IBCIPAD
S VALMHDR(1)=" Name: "_$E(IBCINAM,1,27)_"Sex: "_$E(IBCISEX,1)_" DOB: "_$E(IBCIBIR,1,11)_" Claim: "_$E(IBCICLNO,1,8)_"("_IBCISRR_")"
S VALMHDR(2)=" Ins: "_$E(IBCICAR,1,40)_" Provider: "_$E(IBCIPRV,1,16)
S VALMHDR(3)="Coder: "_$E(IBCICNM,1,16)_" Biller: "_$E(IBCIBIL,1,16)_" Assigned: "_$E(IBCIASN,1,16)
Q
;
INIT ; -- init variables and list array
S QUITDP=0
K ^TMP("IBCIMG",$J),^TMP("IBCIMG1",$J)
S IBCICMP=""
F I=1:1:50 S IBCICMP=IBCICMP_" "
D BLD
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
; User is prompted to enter comments for each claim that has error if
; they exit before fixing the claim.
I ($G(Y)="Q")!($G(Y)=-1) D
. D UTIL2
. I Y'=1 S QUITDP=1 Q
. D CLEAR^VALM1,CLEAN^VALM10
. D COMMENT^IBCIUT7(IBIFN,1)
K ^TMP("IBCILM",$J)
K ^TMP("IBCIMG",$J),^TMP("IBCIMG1",$J)
Q
;
BLD ; build array for display
N IBRT,IBCISEQ,IBCICNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE
N ICDL,ICDSP,ICDXX,LMDX,LMDX2,MODS,MOD2,EOLM
S (IBCICNT,VALMCNT)=1
S IBPREV=""
S IBTC(1)=1,IBTC(2)=30,IBTW(1)=1,IBTW(2)=10,IBSW(1)=79,IBSW(2)=12
; create LM display array
S IBCIERL=0 F S IBCIERL=$O(^TMP("IBCILM",$J,IBCIERL)) Q:'IBCIERL D
. S YARR=""
. S IBCIZZZ=^TMP("IBCILM",$J,IBCIERL,0)
. S IBCIYYY=$TR(IBCIZZZ,"~","^")
. S TYPE=$P($G(IBCIYYY),U,1)
. S IBLINE=$P($G(IBCIYYY),U,2)
. S IBCILEV=$P($G(IBCIYYY),U,3)
. I IBLINE'=IBPREV D
.. S LMLINE="Line: "_IBLINE
.. S IBCILD1=$G(^IBA(351.9,IBIFN,5,IBLINE,0))
.. S IBCILD2=$G(^IBA(351.9,IBIFN,5,IBLINE,2))
.. S LMBDATE=$P($G(IBCILD1),U,6)
.. S LMEDATE=$P($G(IBCILD1),U,7)
.. S LMPOS=$P($G(IBCILD1),U,8)
.. S LMTOS=$P($G(IBCILD2),U,11)
.. S LMUNIT=$P($G(IBCILD2),U,12)
.. S LMCPT=$P($G(IBCILD1),U,9)
.. S LMCHARG=$P($G(IBCILD1),U,11)
.. S MODS=$TR($P($G(^IBA(351.9,IBIFN,5,IBLINE,3)),U,1),",","")
.. S LMMOD=$E(MODS,1,6)
.. S MOD2=$E(MODS,7,14)
.. S YARR=$$SETFLD^VALM1(LMTOS,YARR,"TOS")
.. S YARR=$$SETFLD^VALM1(LMPOS,YARR,"POS")
.. S YARR=$$SETFLD^VALM1(($E(LMBDATE,5,6)_"/"_$E(LMBDATE,7,8)_"/"_$E(LMBDATE,1,4)),YARR,"BDATE")
.. S YARR=$$SETFLD^VALM1(($E(LMEDATE,5,6)_"/"_$E(LMEDATE,7,8)_"/"_$E(LMEDATE,1,4)),YARR,"EDATE")
.. S YARR=$$SETFLD^VALM1($J($FN(LMCHARG,"",2),7),YARR,"CHARGE") ;JSR 6/22/2001 Number Format fix
.. S YARR=$$SETFLD^VALM1(LMCPT,YARR,"CPT")
.. S YARR=$$SETFLD^VALM1(LMMOD,YARR,"MODIFY")
.. S YARR=$$SETFLD^VALM1(LMUNIT,YARR,"UNITS")
.. S YARR=$$SETFLD^VALM1(LMLINE,YARR,"LINE")
.. I IBCICNT'=1 S IBT="",IBD="" S IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
.. S IBT="",IBD=YARR S IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
.. D CNTRL^VALM10((IBCICNT-1),1,79,IOINHI,IOINORM)
.. ; ******
.. D DIAG^IBCIUT1(IBIFN)
.. S ICDXX=""
.. S ICDSP=""
.. S ICDL=""
.. F S ICDL=$O(^TMP("DISPLAY",$J,IBIFN,"ICD",IBLINE,ICDL)) Q:ICDL="" D
... S ICDXX=ICDXX_ICDSP_^TMP("DISPLAY",$J,IBIFN,"ICD",IBLINE,ICDL)
... S ICDSP=" / "
.. S LMDX=" Dx's: "
.. S LMDX2=ICDXX
.. ;
.. ; esg - 10/26/01 - squeeze in 4th thru 7th modifiers on the 2nd line
.. I $L(ICDXX)<46,MOD2'="" S LMDX2=ICDXX_$J("",47-$L(ICDXX))_MOD2
.. S IBLR=1
.. S IBT=$E(LMDX,1,60),IBD=LMDX2 S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
.. D CNTRL^VALM10((IBCICNT-1),1,79,IOINHI,IOINORM)
.. ; *****
.. S IBGRPB=IBCICNT
. I IBLINE=IBPREV D
.. S IBGRPB=IBCICNT,IBLR=1
.. S IBT="",IBD="" S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
. S IBGRPB=IBCICNT,IBLR=1
. S IBPREV=IBLINE
. S IBCISEQ=0 F S IBCISEQ=$O(^TMP("IBCILM",$J,IBCIERL,IBCISEQ)) Q:'IBCISEQ D
.. S IBCICM2="Error Level: "_IBCILEV
.. S IBCICM1="("_IBCIERL_") "_"ClaimsManager Error: "_TYPE_IBCICMP
.. S IBT=$E(IBCICM1,1,60),IBD=IBCICM2 S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
.. S IBCIERT=0 F S IBCIERT=$O(^TMP("IBCILM",$J,IBCIERL,IBCISEQ,IBCIERT)) Q:'IBCIERT D
... S IBGRPB=IBCICNT,IBLR=1
... S DATA=$G(^TMP("IBCILM",$J,IBCIERL,IBCISEQ,IBCIERT,0))
... S IBT=" ",IBD=DATA S IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
... S IBGRPE=IBCICNT,IBCICNT=IBGRPB,IBLR=2
... S (IBCICNT,VALMCNT)=$S(IBCICNT>IBGRPE:IBCICNT,1:IBGRPE)
F I=1:1:5 S IBT="",IBD="" S IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
S EOLM=IBCICNT-7
;
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."
;
K ^TMP("DISPLAY",$J) ; This is the arrary for the dx & line assoc.
Q
;
SETO(RT,LN) ;
; set line number of beginning line of ClaimsManager error message
S ^TMP("IBCIMG1",$J,+$G(RT))=+$G(LN)
Q
;
SET(TTL,DATA,LN,LR) ;
N IBY
S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
S LN=LN+1
Q LN
;
SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
N IBX S IBX=$G(^TMP("IBCIMG",$J,LN,0))
S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
Q
CBILL ;Cancel Bill
; Uses core IB and takes user cancel and populates Comment
D CLEAR^VALM1
N IBQUIT,IBCCCC,I,IBCICNCL
S IBCICNCL=1
D PROCESS^IBCC(IBIFN) I IBQUIT=1 S VALMBCK="R" Q
S VALMBCK="Q"
K ^TMP("IBCILM",$J)
Q
EBILL ; re-edit action no need to capture comments
; Uses core IB routines and allows user to re-edit bill
D CLEAR^VALM1,CLEAN^VALM10
S IBCIREDT=1
Q
ABILL ; override action
; This Protocol driven option only appears for those user witht he override key
N IBCISNT
S VALMBCK="R"
S DIR(0)="Y"
S DIR("A")="Are you sure you want to Override the errors of this bill"
S DIR("B")="YES"
D ^DIR K DIR
Q:$D(DIRUT)
I Y'=1 Q
S VALMBCK="Q"
D CLEAR^VALM1,CLEAN^VALM10
S IBCISNT=5
D ST2^IBCIST
D COMMENT^IBCIUT7(IBIFN,2)
Q
XIT ;
S VALMBCK="R"
D UTIL2
I Y'=1 Q
S VALMBCK="Q"
D CLEAR^VALM1,CLEAN^VALM10
D COMMENT^IBCIUT7(IBIFN,1)
Q
;
UTIL2 ;
S DIR(0)="Y"
S DIR("A")="Are you sure you want to Exit the ClaimsManager Interface process"
S DIR("B")="YES"
D ^DIR K DIR
I $D(DIRUT) S Y=1
K DIRUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIMG 7431 printed Dec 13, 2024@02:13:18 Page 2
IBCIMG ;DSI/JSR - IBCI CLAIMS MANAGER MGR WORKSHEET ;6-MAR-2001
+1 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;; Program Description:
+4 ; This routine is a ListManager routine invoked when the user is in
+5 ; the bill edit screen. This is a hybrid routine used for 3 reasons:
+6 ; 1) To define and display all ListManager Template data with
+7 ; aesthetic consistency.
+8 ; 2) To permit Overriding Access for override CM errors.
+9 ; 3) To Define and display MailMan header claims specific
+10 ; information
+11 ; IBCIMG is the main routine utilized when calling all 3 ListManager
+12 ; templates. IBCIMG contains all the visual display details for all
+13 ; LM templates and is also utilized for the building of MailMan
+14 ; Messages.
+15 ; Manager Access:
+16 ; Is only permitted when IBCIMG security key action is
+17 ; allocated for Manager Override access.
+18 ; MailMan Messages:
+19 ; Invoked by IBCIUT6 with a call to HDR^IBCIMG.
EN ; -- main entry point
+1 DO EN^VALM("IBCI CLAIMSMANAGER MGR WK")
+2 QUIT
+3 ;
HDR ; -- header code
+1 if '$DATA(IBCINAM)
SET IBCINAM=IBCIPAD
+2 if '$DATA(IBCICLNO)
SET IBCICLNO=IBCIPAD
+3 if '$DATA(IBCIBIR)
SET IBCIBIR=IBCIPAD
+4 if '$DATA(IBCISEX)
SET IBCISEX=IBCIPAD
+5 if '$DATA(IBCICNM)
SET IBCICNM=IBCIPAD
+6 if '$DATA(IBCIASN)
SET IBCIASN=IBCIPAD
+7 if '$DATA(IBCIBIL)
SET IBCIBIL=IBCIPAD
+8 if '$DATA(IBCISRR)
SET IBCISRR=IBCIPAD
+9 if '$DATA(IBCIEVV)
SET IBCIEVV=IBCIPAD
+10 if '$DATA(IBCICAR)
SET IBCICAR=IBCIPAD_IBCIPAD
+11 SET VALMHDR(1)=" Name: "_$EXTRACT(IBCINAM,1,27)_"Sex: "_$EXTRACT(IBCISEX,1)_" DOB: "_$EXTRACT(IBCIBIR,1,11)_" Claim: "_$EXTRACT(IBCICLNO,1,8)_"("_IBCISRR_")"
+12 SET VALMHDR(2)=" Ins: "_$EXTRACT(IBCICAR,1,40)_" Provider: "_$EXTRACT(IBCIPRV,1,16)
+13 SET VALMHDR(3)="Coder: "_$EXTRACT(IBCICNM,1,16)_" Biller: "_$EXTRACT(IBCIBIL,1,16)_" Assigned: "_$EXTRACT(IBCIASN,1,16)
+14 QUIT
+15 ;
INIT ; -- init variables and list array
+1 SET QUITDP=0
+2 KILL ^TMP("IBCIMG",$JOB),^TMP("IBCIMG1",$JOB)
+3 SET IBCICMP=""
+4 FOR I=1:1:50
SET IBCICMP=IBCICMP_" "
+5 DO BLD
+6 QUIT
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 ; User is prompted to enter comments for each claim that has error if
+2 ; they exit before fixing the claim.
+3 IF ($GET(Y)="Q")!($GET(Y)=-1)
Begin DoDot:1
+4 DO UTIL2
+5 IF Y'=1
SET QUITDP=1
QUIT
+6 DO CLEAR^VALM1
DO CLEAN^VALM10
+7 DO COMMENT^IBCIUT7(IBIFN,1)
End DoDot:1
+8 KILL ^TMP("IBCILM",$JOB)
+9 KILL ^TMP("IBCIMG",$JOB),^TMP("IBCIMG1",$JOB)
+10 QUIT
+11 ;
BLD ; build array for display
+1 NEW IBRT,IBCISEQ,IBCICNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE
+2 NEW ICDL,ICDSP,ICDXX,LMDX,LMDX2,MODS,MOD2,EOLM
+3 SET (IBCICNT,VALMCNT)=1
+4 SET IBPREV=""
+5 SET IBTC(1)=1
SET IBTC(2)=30
SET IBTW(1)=1
SET IBTW(2)=10
SET IBSW(1)=79
SET IBSW(2)=12
+6 ; create LM display array
+7 SET IBCIERL=0
FOR
SET IBCIERL=$ORDER(^TMP("IBCILM",$JOB,IBCIERL))
if 'IBCIERL
QUIT
Begin DoDot:1
+8 SET YARR=""
+9 SET IBCIZZZ=^TMP("IBCILM",$JOB,IBCIERL,0)
+10 SET IBCIYYY=$TRANSLATE(IBCIZZZ,"~","^")
+11 SET TYPE=$PIECE($GET(IBCIYYY),U,1)
+12 SET IBLINE=$PIECE($GET(IBCIYYY),U,2)
+13 SET IBCILEV=$PIECE($GET(IBCIYYY),U,3)
+14 IF IBLINE'=IBPREV
Begin DoDot:2
+15 SET LMLINE="Line: "_IBLINE
+16 SET IBCILD1=$GET(^IBA(351.9,IBIFN,5,IBLINE,0))
+17 SET IBCILD2=$GET(^IBA(351.9,IBIFN,5,IBLINE,2))
+18 SET LMBDATE=$PIECE($GET(IBCILD1),U,6)
+19 SET LMEDATE=$PIECE($GET(IBCILD1),U,7)
+20 SET LMPOS=$PIECE($GET(IBCILD1),U,8)
+21 SET LMTOS=$PIECE($GET(IBCILD2),U,11)
+22 SET LMUNIT=$PIECE($GET(IBCILD2),U,12)
+23 SET LMCPT=$PIECE($GET(IBCILD1),U,9)
+24 SET LMCHARG=$PIECE($GET(IBCILD1),U,11)
+25 SET MODS=$TRANSLATE($PIECE($GET(^IBA(351.9,IBIFN,5,IBLINE,3)),U,1),",","")
+26 SET LMMOD=$EXTRACT(MODS,1,6)
+27 SET MOD2=$EXTRACT(MODS,7,14)
+28 SET YARR=$$SETFLD^VALM1(LMTOS,YARR,"TOS")
+29 SET YARR=$$SETFLD^VALM1(LMPOS,YARR,"POS")
+30 SET YARR=$$SETFLD^VALM1(($EXTRACT(LMBDATE,5,6)_"/"_$EXTRACT(LMBDATE,7,8)_"/"_$EXTRACT(LMBDATE,1,4)),YARR,"BDATE")
+31 SET YARR=$$SETFLD^VALM1(($EXTRACT(LMEDATE,5,6)_"/"_$EXTRACT(LMEDATE,7,8)_"/"_$EXTRACT(LMEDATE,1,4)),YARR,"EDATE")
+32 ;JSR 6/22/2001 Number Format fix
SET YARR=$$SETFLD^VALM1($JUSTIFY($FNUMBER(LMCHARG,"",2),7),YARR,"CHARGE")
+33 SET YARR=$$SETFLD^VALM1(LMCPT,YARR,"CPT")
+34 SET YARR=$$SETFLD^VALM1(LMMOD,YARR,"MODIFY")
+35 SET YARR=$$SETFLD^VALM1(LMUNIT,YARR,"UNITS")
+36 SET YARR=$$SETFLD^VALM1(LMLINE,YARR,"LINE")
+37 IF IBCICNT'=1
SET IBT=""
SET IBD=""
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
+38 SET IBT=""
SET IBD=YARR
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
+39 DO CNTRL^VALM10((IBCICNT-1),1,79,IOINHI,IOINORM)
+40 ; ******
+41 DO DIAG^IBCIUT1(IBIFN)
+42 SET ICDXX=""
+43 SET ICDSP=""
+44 SET ICDL=""
+45 FOR
SET ICDL=$ORDER(^TMP("DISPLAY",$JOB,IBIFN,"ICD",IBLINE,ICDL))
if ICDL=""
QUIT
Begin DoDot:3
+46 SET ICDXX=ICDXX_ICDSP_^TMP("DISPLAY",$JOB,IBIFN,"ICD",IBLINE,ICDL)
+47 SET ICDSP=" / "
End DoDot:3
+48 SET LMDX=" Dx's: "
+49 SET LMDX2=ICDXX
+50 ;
+51 ; esg - 10/26/01 - squeeze in 4th thru 7th modifiers on the 2nd line
+52 IF $LENGTH(ICDXX)<46
IF MOD2'=""
SET LMDX2=ICDXX_$JUSTIFY("",47-$LENGTH(ICDXX))_MOD2
+53 SET IBLR=1
+54 SET IBT=$EXTRACT(LMDX,1,60)
SET IBD=LMDX2
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
+55 DO CNTRL^VALM10((IBCICNT-1),1,79,IOINHI,IOINORM)
+56 ; *****
+57 SET IBGRPB=IBCICNT
End DoDot:2
+58 IF IBLINE=IBPREV
Begin DoDot:2
+59 SET IBGRPB=IBCICNT
SET IBLR=1
+60 SET IBT=""
SET IBD=""
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
End DoDot:2
+61 SET IBGRPB=IBCICNT
SET IBLR=1
+62 SET IBPREV=IBLINE
+63 SET IBCISEQ=0
FOR
SET IBCISEQ=$ORDER(^TMP("IBCILM",$JOB,IBCIERL,IBCISEQ))
if 'IBCISEQ
QUIT
Begin DoDot:2
+64 SET IBCICM2="Error Level: "_IBCILEV
+65 SET IBCICM1="("_IBCIERL_") "_"ClaimsManager Error: "_TYPE_IBCICMP
+66 SET IBT=$EXTRACT(IBCICM1,1,60)
SET IBD=IBCICM2
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
+67 SET IBCIERT=0
FOR
SET IBCIERT=$ORDER(^TMP("IBCILM",$JOB,IBCIERL,IBCISEQ,IBCIERT))
if 'IBCIERT
QUIT
Begin DoDot:3
+68 SET IBGRPB=IBCICNT
SET IBLR=1
+69 SET DATA=$GET(^TMP("IBCILM",$JOB,IBCIERL,IBCISEQ,IBCIERT,0))
+70 SET IBT=" "
SET IBD=DATA
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,IBLR)
+71 SET IBGRPE=IBCICNT
SET IBCICNT=IBGRPB
SET IBLR=2
+72 SET (IBCICNT,VALMCNT)=$SELECT(IBCICNT>IBGRPE:IBCICNT,1:IBGRPE)
End DoDot:3
End DoDot:2
End DoDot:1
+73 FOR I=1:1:5
SET IBT=""
SET IBD=""
SET IBCICNT=$$SET(IBT,IBD,IBCICNT,1)
+74 SET EOLM=IBCICNT-7
+75 ;
+76 IF EOLM=-1
SET IBCICNT=$$SET(" ","",1,1)
SET IBCICNT=$$SET("No ERRORS defined for claim EVENT DATE: "_IBCIEVV,"",2,1)
SET VALMSG="No Errors found by ClaimsManager."
+77 ;
+78 ; This is the arrary for the dx & line assoc.
KILL ^TMP("DISPLAY",$JOB)
+79 QUIT
+80 ;
SETO(RT,LN) ;
+1 ; set line number of beginning line of ClaimsManager error message
+2 SET ^TMP("IBCIMG1",$JOB,+$GET(RT))=+$GET(LN)
+3 QUIT
+4 ;
SET(TTL,DATA,LN,LR) ;
+1 NEW IBY
+2 SET IBY=$JUSTIFY(TTL,IBTW(LR))_DATA
DO SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
+3 SET LN=LN+1
+4 QUIT LN
+5 ;
SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
+1 NEW IBX
SET IBX=$GET(^TMP("IBCIMG",$JOB,LN,0))
+2 SET IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
+3 DO SET^VALM10(LN,IBX)
IF $GET(RV)'=""
DO CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
+4 QUIT
CBILL ;Cancel Bill
+1 ; Uses core IB and takes user cancel and populates Comment
+2 DO CLEAR^VALM1
+3 NEW IBQUIT,IBCCCC,I,IBCICNCL
+4 SET IBCICNCL=1
+5 DO PROCESS^IBCC(IBIFN)
IF IBQUIT=1
SET VALMBCK="R"
QUIT
+6 SET VALMBCK="Q"
+7 KILL ^TMP("IBCILM",$JOB)
+8 QUIT
EBILL ; re-edit action no need to capture comments
+1 ; Uses core IB routines and allows user to re-edit bill
+2 DO CLEAR^VALM1
DO CLEAN^VALM10
+3 SET IBCIREDT=1
+4 QUIT
ABILL ; override action
+1 ; This Protocol driven option only appears for those user witht he override key
+2 NEW IBCISNT
+3 SET VALMBCK="R"
+4 SET DIR(0)="Y"
+5 SET DIR("A")="Are you sure you want to Override the errors of this bill"
+6 SET DIR("B")="YES"
+7 DO ^DIR
KILL DIR
+8 if $DATA(DIRUT)
QUIT
+9 IF Y'=1
QUIT
+10 SET VALMBCK="Q"
+11 DO CLEAR^VALM1
DO CLEAN^VALM10
+12 SET IBCISNT=5
+13 DO ST2^IBCIST
+14 DO COMMENT^IBCIUT7(IBIFN,2)
+15 QUIT
XIT ;
+1 SET VALMBCK="R"
+2 DO UTIL2
+3 IF Y'=1
QUIT
+4 SET VALMBCK="Q"
+5 DO CLEAR^VALM1
DO CLEAN^VALM10
+6 DO COMMENT^IBCIUT7(IBIFN,1)
+7 QUIT
+8 ;
UTIL2 ;
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Are you sure you want to Exit the ClaimsManager Interface process"
+3 SET DIR("B")="YES"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
SET Y=1
+6 KILL DIRUT
+7 QUIT
