IBCECSA3 ;ALB/CXW - CLAIMS STATUS AWAITING RESOLUTION REPORT ;23-JUL-99
;;2.0;INTEGRATED BILLING;**137,320,371,377**;21-MAR-94;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
EN ; Report of claims status awaiting resolution
NEW %ZIS,ZTSAVE,ZTRTN,ZTDESC,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBRVW
;
D FULL^VALM1
W !
S DIR(0)="YO" ; IB*2*377 new question
S DIR("A")="Would you like to include Review Comments with this report"
S DIR("B")="No"
D ^DIR K DIR
I $D(DIRUT) Q
S IBRVW=Y
;
W !!,"You will need a 132 column printer for this report!",!
;
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) K IO("Q") D Q
. S ZTRTN="LIST^IBCECSA3"
. S ZTSAVE("IBSORT1")=""
. S ZTSAVE("IBSORT2")=""
. S ZTSAVE("IBSORT3")=""
. S ZTSAVE("IBSORTOR")=""
. S ZTSAVE("^TMP(""IBCECSB"",$J,")=""
. S ZTSAVE("IBRVW")=""
. S ZTDESC="IB -Claims Status Awaiting Resolution Report" D ^%ZTLOAD K ZTSK D HOME^%ZIS
U IO
LIST ; display
N IBSTOP,X,IBPAGE,IBX,IBDIV,IBDA,IBPAY,IB,IBZ,IBZFT,IBFST,IBX2
W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
S (IBSTOP,IBPAGE,IBFST,IBDIV)=0
I IBSORT1="D" S IBDIV=1
I '$D(^TMP("IBCECSB",$J)) D G LISTQ
. D HDR1 W !,"No entries found for this report"
S IBX="" F S IBX=$O(^TMP("IBCECSB",$J,IBX)) Q:IBX=""!IBSTOP S IBX2="" F S IBX2=$O(^TMP("IBCECSB",$J,IBX,IBX2)) Q:IBX2=""!IBSTOP S IBX3="" F S IBX3=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3)) Q:IBX3=""!IBSTOP D Q:IBSTOP
. I 'IBFST S IBPAY=$$IBPAY(IBX,IBX2,IBX3) D HDR1 S:'IBDIV IBFST=1 Q:IBSTOP
. S IBDA=0 F S IBDA=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) Q:'IBDA!IBSTOP S IB=$G(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) D Q:IBSTOP
.. I ($Y+3)>IOSL D HDR1 Q:IBSTOP
.. W $$BN1^PRCAFN(+IB),$P(IB,U,12),?13,$E($P(IB,U,2),1,25),?40,$E($P(IB,U,3),1,30),?72,$P($P(IB,U,4),"~"),?78,$$DAT1^IBOUTL($P(IB,U,5)),?88,$E($P(IB,U,7),1,10),?100,"$"_$J($P(IB,U,6),0,2),?110,$P(IB,U,10),?122,$P(IB,U,11),!
.. I $P(IB,U,12)="*" W " ***** CSA REVIEW IN PROCESS *****",!
.. W " FORM TYPE: "_$P($G(^IBE(353,$P($G(^DGCR(399,+IB,0)),U,19),0)),U),!
.. I 'IBDIV S X=" DIVISION: "_$P(IB,U,8) W X,$J(" ",40-$L(X))_"AUTHORIZING BILLER: "_$P($P(IB,U,9),"~",1),!
.. W " MESSAGE TEXT: " S IBZFT=0
.. S IBZ=0 F S IBZ=$O(^IBM(361,IBDA,1,IBZ)) Q:'IBZ D Q:IBSTOP
... W:'IBZFT ?15 S X=$G(^IBM(361,IBDA,1,IBZ,0))
... F I=1:131:$L(X) W " "_$E(X,I,I+130),!
... S IBZFT=1
... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
... Q
.. Q:IBSTOP
.. ;
.. ; Display the Review Comments if they exist based on user choice (IB*377)
.. I $G(IBRVW),+$O(^IBM(361,IBDA,2,0)) D Q:IBSTOP
... N IBCM,IBT1,IBT0,IBD0,IBCL
... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
... W ?3,"*** Review Comments for Claim "_$$BN1^PRCAFN(+IB)_" ***",!
... S IBCM=0 F IBT1=0:1 S IBCM=$O(^IBM(361,IBDA,2,IBCM)) Q:'IBCM ; count up # of comments
... S IBT0=0
... S IBCM=0 F S IBCM=$O(^IBM(361,IBDA,2,IBCM)) Q:'IBCM!IBSTOP D Q:IBSTOP
.... S IBT0=IBT0+1
.... S IBD0=$G(^IBM(361,IBDA,2,IBCM,0))
.... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
.... W ?7,"Entered "_$$FMTE^XLFDT($P(IBD0,U,1),"5ZPM")
.... I $P(IBD0,U,2) W " by "_$P($G(^VA(200,$P(IBD0,U,2),0)),U,1)
.... W " ("_IBT0_" of "_IBT1_")",!
.... S IBCL=0 F S IBCL=$O(^IBM(361,IBDA,2,IBCM,1,IBCL)) Q:'IBCL!IBSTOP D Q:IBSTOP
..... I ($Y+3)>IOSL D HDR1 Q:IBSTOP
..... W ?10,$G(^IBM(361,IBDA,2,IBCM,1,IBCL,0)),!
..... Q
.... Q
... Q
.. ;
.. ; Display a line break before the next claim in this report
.. I ($Y+3)>IOSL D HDR1 Q:IBSTOP
.. W !
.. Q
. Q
;
G:IBSTOP LISTQ
I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
LISTQ I $D(ZTQUEUED) S ZTREQ="@" Q
W ! D ^%ZISC
Q
IBPAY(IBX,IBX2,IBX3) ; return biller name
N X
S X=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,0))
S X=$G(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,X))
Q $P($P(X,U,9),"~",1)
HDR1 ;
N DIR,Y
I IBPAGE D Q:IBSTOP
. I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
. W @IOF
S IBPAGE=IBPAGE+1
W !,"Sort 1: ",$$SD^IBCECSA(IBSORT1)
W ?46,"Claims Status Awaiting Resolution Report",?120,$J("Page: "_IBPAGE,11)
W !,"Sort 2: ",$S($G(IBSORT2)'="":$$SD^IBCECSA(IBSORT2),1:"n/a")
W ?104,$J("Run Date: "_$$HTE^XLFDT($H,"2Z"),27)
W !,"Sort 3: ",$S($G(IBSORT3)'="":$$SD^IBCECSA(IBSORT3),1:"n/a")
I IBDIV W !!,"Division: "_$S($G(IBX)=0:"",1:$G(IBX)),!,"Authorizing Biller: "_$G(IBPAY)
W !,?72,"Last",?78,"Date of",?88,"Location",?100,"Current",?110,"Source of",?122,"Days Msg"
W !,"Bill #",?13,"Payer Name",?40,"Patient Name",?72,"4 SSN",?78,"Service",?88,"of Service",?100,"Balance",?110,"Message",?122,"Pending"
W !,$TR($J("",132)," ","-"),!
Q
;
;
RESORT ; CSA screen re-sort action
NEW DIR,X,Y,Z,IBSAVE,VALMQUIT,IBCURR
D FULL^VALM1 S VALMBCK="R"
W !!?2,"The CSA screen is currently sorted in the following manner:"
W !!?9,"Primary Sort: ",$S($G(IBSORT1)'="":$$SD^IBCECSA(IBSORT1),1:"n/a")
W !?7,"Secondary Sort: ",$S($G(IBSORT2)'="":$$SD^IBCECSA(IBSORT2),1:"n/a")
W !?8,"Tertiary Sort: ",$S($G(IBSORT3)'="":$$SD^IBCECSA(IBSORT3),1:"n/a")
;
W !
S DIR(0)="Y",DIR("A")="Would you like to change the sort criteria"
S DIR("B")="Yes" D ^DIR K DIR
I 'Y G RESORTX
;
; save the old sort criteria
S IBSAVE=$G(IBSORT1)_U_$G(IBSORT2)_U_$G(IBSORT3)
S Z="" F S Z=$O(IBSORTOR(Z)) Q:Z="" S IBSAVE=IBSAVE_U_Z_U_IBSORTOR(Z)
;
W !
K IBSORTOR
D SORT^IBCECSA(1,$P(IBSAVE,U,1)) I $G(VALMQUIT) G RES1
D SORT^IBCECSA(2) I $G(VALMQUIT) G RES1
I $G(IBSORT2)'="" D SORT^IBCECSA(3) I $G(VALMQUIT) G RES1
RES1 ;
I $G(IBSORT1)="" S IBSORT1=$P(IBSAVE,U,1) ; need at least one
;
; see if the sort criteria changed
S IBCURR=$G(IBSORT1)_U_$G(IBSORT2)_U_$G(IBSORT3)
S Z="" F S Z=$O(IBSORTOR(Z)) Q:Z="" S IBCURR=IBCURR_U_Z_U_IBSORTOR(Z)
I IBSAVE=IBCURR G RESORTX ; no sort changes made at all
;
; time to rebuild the list because sorts have changed
I $G(IBDAYS)="" S IBDAYS=0
I $G(IBSEV)="" S IBSEV="R"
D BLD^IBCECSA1
S VALMBCK="R",VALMBG=1
;
RESORTX ;
Q
;
MCS ; Link to the Multiple CSA Message Management option
NEW IBCSAMCS S IBCSAMCS=1
D FULL^VALM1 S VALMBCK="R"
I '$$KCHK^XUSRB("IB MESSAGE MANAGEMENT") D G MCSX
. W !!?5,"You must hold the IB MESSAGE MANAGEMENT key to access this option."
. D PAUSE^VALM1
. Q
;
D ; call the MCS screen
. NEW IBSORT1,IBSORT2,IBSORT3,IBDAYS,IBSEV ; protect CSA vars
. D EN^IBCEMCL
. Q
;
I $G(IBCSAMCS)=2 D BLD^IBCECSA1 S VALMBG=1 ; rebuild CSA
S VALMBCK="R"
MCSX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECSA3 6524 printed Apr 09, 2024@21:22:55 Page 2
IBCECSA3 ;ALB/CXW - CLAIMS STATUS AWAITING RESOLUTION REPORT ;23-JUL-99
+1 ;;2.0;INTEGRATED BILLING;**137,320,371,377**;21-MAR-94;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
EN ; Report of claims status awaiting resolution
+1 NEW %ZIS,ZTSAVE,ZTRTN,ZTDESC,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBRVW
+2 ;
+3 DO FULL^VALM1
+4 WRITE !
+5 ; IB*2*377 new question
SET DIR(0)="YO"
+6 SET DIR("A")="Would you like to include Review Comments with this report"
+7 SET DIR("B")="No"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
QUIT
+10 SET IBRVW=Y
+11 ;
+12 WRITE !!,"You will need a 132 column printer for this report!",!
+13 ;
+14 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+15 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+16 SET ZTRTN="LIST^IBCECSA3"
+17 SET ZTSAVE("IBSORT1")=""
+18 SET ZTSAVE("IBSORT2")=""
+19 SET ZTSAVE("IBSORT3")=""
+20 SET ZTSAVE("IBSORTOR")=""
+21 SET ZTSAVE("^TMP(""IBCECSB"",$J,")=""
+22 SET ZTSAVE("IBRVW")=""
+23 SET ZTDESC="IB -Claims Status Awaiting Resolution Report"
DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
QUIT
+24 USE IO
LIST ; display
+1 NEW IBSTOP,X,IBPAGE,IBX,IBDIV,IBDA,IBPAY,IB,IBZ,IBZFT,IBFST,IBX2
+2 ;Only initial form feed for print to screen
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 SET (IBSTOP,IBPAGE,IBFST,IBDIV)=0
+4 IF IBSORT1="D"
SET IBDIV=1
+5 IF '$DATA(^TMP("IBCECSB",$JOB))
Begin DoDot:1
+6 DO HDR1
WRITE !,"No entries found for this report"
End DoDot:1
GOTO LISTQ
+7 SET IBX=""
FOR
SET IBX=$ORDER(^TMP("IBCECSB",$JOB,IBX))
if IBX=""!IBSTOP
QUIT
SET IBX2=""
FOR
SET IBX2=$ORDER(^TMP("IBCECSB",$JOB,IBX,IBX2))
if IBX2=""!IBSTOP
QUIT
SET IBX3=""
FOR
SET IBX3=$ORDER(^TMP("IBCECSB",$JOB,IBX,IBX2,IBX3))
if IBX3=""!IBSTOP
QUIT
Begin DoDot:1
+8 IF 'IBFST
SET IBPAY=$$IBPAY(IBX,IBX2,IBX3)
DO HDR1
if 'IBDIV
SET IBFST=1
if IBSTOP
QUIT
+9 SET IBDA=0
FOR
SET IBDA=$ORDER(^TMP("IBCECSB",$JOB,IBX,IBX2,IBX3,IBDA))
if 'IBDA!IBSTOP
QUIT
SET IB=$GET(^TMP("IBCECSB",$JOB,IBX,IBX2,IBX3,IBDA))
Begin DoDot:2
+10 IF ($Y+3)>IOSL
DO HDR1
if IBSTOP
QUIT
+11 WRITE $$BN1^PRCAFN(+IB),$PIECE(IB,U,12),?13,$EXTRACT($PIECE(IB,U,2),1,25),?40,$EXTRACT($PIECE(IB,U,3),1,30),?72,$PIECE(...
... $PIECE(IB,U,4),"~"),?78,$$DAT1^IBOUTL($PIECE(IB,U,5)),?88,$EXTRACT($PIECE(IB,U,7),1,10),?100,"$"_$JUSTIFY($PIECE(IB,U,6),0,2),?110,$PIECE(IB,U,10),?122,$PIECE(IB,U,11),!
+12 IF $PIECE(IB,U,12)="*"
WRITE " ***** CSA REVIEW IN PROCESS *****",!
+13 WRITE " FORM TYPE: "_$PIECE($GET(^IBE(353,$PIECE($GET(^DGCR(399,+IB,0)),U,19),0)),U),!
+14 IF 'IBDIV
SET X=" DIVISION: "_$PIECE(IB,U,8)
WRITE X,$JUSTIFY(" ",40-$LENGTH(X))_"AUTHORIZING BILLER: "_$PIECE($PIECE(IB,U,9),"~",1),!
+15 WRITE " MESSAGE TEXT: "
SET IBZFT=0
+16 SET IBZ=0
FOR
SET IBZ=$ORDER(^IBM(361,IBDA,1,IBZ))
if 'IBZ
QUIT
Begin DoDot:3
+17 if 'IBZFT
WRITE ?15
SET X=$GET(^IBM(361,IBDA,1,IBZ,0))
+18 FOR I=1:131:$LENGTH(X)
WRITE " "_$EXTRACT(X,I,I+130),!
+19 SET IBZFT=1
+20 IF ($Y+3)>IOSL
DO HDR1
if IBSTOP
QUIT
+21 QUIT
End DoDot:3
if IBSTOP
QUIT
+22 if IBSTOP
QUIT
+23 ;
+24 ; Display the Review Comments if they exist based on user choice (IB*377)
+25 IF $GET(IBRVW)
IF +$ORDER(^IBM(361,IBDA,2,0))
Begin DoDot:3
+26 NEW IBCM,IBT1,IBT0,IBD0,IBCL
+27 IF ($Y+3)>IOSL
DO HDR1
if IBSTOP
QUIT
+28 WRITE ?3,"*** Review Comments for Claim "_$$BN1^PRCAFN(+IB)_" ***",!
+29 ; count up # of comments
SET IBCM=0
FOR IBT1=0:1
SET IBCM=$ORDER(^IBM(361,IBDA,2,IBCM))
if 'IBCM
QUIT
+30 SET IBT0=0
+31 SET IBCM=0
FOR
SET IBCM=$ORDER(^IBM(361,IBDA,2,IBCM))
if 'IBCM!IBSTOP
QUIT
Begin DoDot:4
+32 SET IBT0=IBT0+1
+33 SET IBD0=$GET(^IBM(361,IBDA,2,IBCM,0))
+34 IF ($Y+3)>IOSL
DO HDR1
if IBSTOP
QUIT
+35 WRITE ?7,"Entered "_$$FMTE^XLFDT($PIECE(IBD0,U,1),"5ZPM")
+36 IF $PIECE(IBD0,U,2)
WRITE " by "_$PIECE($GET(^VA(200,$PIECE(IBD0,U,2),0)),U,1)
+37 WRITE " ("_IBT0_" of "_IBT1_")",!
+38 SET IBCL=0
FOR
SET IBCL=$ORDER(^IBM(361,IBDA,2,IBCM,1,IBCL))
if 'IBCL!IBSTOP
QUIT
Begin DoDot:5
+39 IF ($Y+3)>IOSL
DO HDR1
if IBSTOP
QUIT
+40 WRITE ?10,$GET(^IBM(361,IBDA,2,IBCM,1,IBCL,0)),!
+41 QUIT
End DoDot:5
if IBSTOP
QUIT
+42 QUIT
End DoDot:4
if IBSTOP
QUIT
+43 QUIT
End DoDot:3
if IBSTOP
QUIT
+44 ;
+45 ; Display a line break before the next claim in this report
+46 IF ($Y+3)>IOSL
DO HDR1
if IBSTOP
QUIT
+47 WRITE !
+48 QUIT
End DoDot:2
if IBSTOP
QUIT
+49 QUIT
End DoDot:1
if IBSTOP
QUIT
+50 ;
+51 if IBSTOP
GOTO LISTQ
+52 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
LISTQ IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 WRITE !
DO ^%ZISC
+2 QUIT
IBPAY(IBX,IBX2,IBX3) ; return biller name
+1 NEW X
+2 SET X=$ORDER(^TMP("IBCECSB",$JOB,IBX,IBX2,IBX3,0))
+3 SET X=$GET(^TMP("IBCECSB",$JOB,IBX,IBX2,IBX3,X))
+4 QUIT $PIECE($PIECE(X,U,9),"~",1)
HDR1 ;
+1 NEW DIR,Y
+2 IF IBPAGE
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET IBSTOP=('Y)
if IBSTOP
QUIT
+4 WRITE @IOF
End DoDot:1
if IBSTOP
QUIT
+5 SET IBPAGE=IBPAGE+1
+6 WRITE !,"Sort 1: ",$$SD^IBCECSA(IBSORT1)
+7 WRITE ?46,"Claims Status Awaiting Resolution Report",?120,$JUSTIFY("Page: "_IBPAGE,11)
+8 WRITE !,"Sort 2: ",$SELECT($GET(IBSORT2)'="":$$SD^IBCECSA(IBSORT2),1:"n/a")
+9 WRITE ?104,$JUSTIFY("Run Date: "_$$HTE^XLFDT($HOROLOG,"2Z"),27)
+10 WRITE !,"Sort 3: ",$SELECT($GET(IBSORT3)'="":$$SD^IBCECSA(IBSORT3),1:"n/a")
+11 IF IBDIV
WRITE !!,"Division: "_$SELECT($GET(IBX)=0:"",1:$GET(IBX)),!,"Authorizing Biller: "_$GET(IBPAY)
+12 WRITE !,?72,"Last",?78,"Date of",?88,"Location",?100,"Current",?110,"Source of",?122,"Days Msg"
+13 WRITE !,"Bill #",?13,"Payer Name",?40,"Patient Name",?72,"4 SSN",?78,"Service",?88,"of Service",?100,"Balance",?110,"Message",?122,"Pending"
+14 WRITE !,$TRANSLATE($JUSTIFY("",132)," ","-"),!
+15 QUIT
+16 ;
+17 ;
RESORT ; CSA screen re-sort action
+1 NEW DIR,X,Y,Z,IBSAVE,VALMQUIT,IBCURR
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 WRITE !!?2,"The CSA screen is currently sorted in the following manner:"
+4 WRITE !!?9,"Primary Sort: ",$SELECT($GET(IBSORT1)'="":$$SD^IBCECSA(IBSORT1),1:"n/a")
+5 WRITE !?7,"Secondary Sort: ",$SELECT($GET(IBSORT2)'="":$$SD^IBCECSA(IBSORT2),1:"n/a")
+6 WRITE !?8,"Tertiary Sort: ",$SELECT($GET(IBSORT3)'="":$$SD^IBCECSA(IBSORT3),1:"n/a")
+7 ;
+8 WRITE !
+9 SET DIR(0)="Y"
SET DIR("A")="Would you like to change the sort criteria"
+10 SET DIR("B")="Yes"
DO ^DIR
KILL DIR
+11 IF 'Y
GOTO RESORTX
+12 ;
+13 ; save the old sort criteria
+14 SET IBSAVE=$GET(IBSORT1)_U_$GET(IBSORT2)_U_$GET(IBSORT3)
+15 SET Z=""
FOR
SET Z=$ORDER(IBSORTOR(Z))
if Z=""
QUIT
SET IBSAVE=IBSAVE_U_Z_U_IBSORTOR(Z)
+16 ;
+17 WRITE !
+18 KILL IBSORTOR
+19 DO SORT^IBCECSA(1,$PIECE(IBSAVE,U,1))
IF $GET(VALMQUIT)
GOTO RES1
+20 DO SORT^IBCECSA(2)
IF $GET(VALMQUIT)
GOTO RES1
+21 IF $GET(IBSORT2)'=""
DO SORT^IBCECSA(3)
IF $GET(VALMQUIT)
GOTO RES1
RES1 ;
+1 ; need at least one
IF $GET(IBSORT1)=""
SET IBSORT1=$PIECE(IBSAVE,U,1)
+2 ;
+3 ; see if the sort criteria changed
+4 SET IBCURR=$GET(IBSORT1)_U_$GET(IBSORT2)_U_$GET(IBSORT3)
+5 SET Z=""
FOR
SET Z=$ORDER(IBSORTOR(Z))
if Z=""
QUIT
SET IBCURR=IBCURR_U_Z_U_IBSORTOR(Z)
+6 ; no sort changes made at all
IF IBSAVE=IBCURR
GOTO RESORTX
+7 ;
+8 ; time to rebuild the list because sorts have changed
+9 IF $GET(IBDAYS)=""
SET IBDAYS=0
+10 IF $GET(IBSEV)=""
SET IBSEV="R"
+11 DO BLD^IBCECSA1
+12 SET VALMBCK="R"
SET VALMBG=1
+13 ;
RESORTX ;
+1 QUIT
+2 ;
MCS ; Link to the Multiple CSA Message Management option
+1 NEW IBCSAMCS
SET IBCSAMCS=1
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 IF '$$KCHK^XUSRB("IB MESSAGE MANAGEMENT")
Begin DoDot:1
+4 WRITE !!?5,"You must hold the IB MESSAGE MANAGEMENT key to access this option."
+5 DO PAUSE^VALM1
+6 QUIT
End DoDot:1
GOTO MCSX
+7 ;
+8 ; call the MCS screen
Begin DoDot:1
+9 ; protect CSA vars
NEW IBSORT1,IBSORT2,IBSORT3,IBDAYS,IBSEV
+10 DO EN^IBCEMCL
+11 QUIT
End DoDot:1
+12 ;
+13 ; rebuild CSA
IF $GET(IBCSAMCS)=2
DO BLD^IBCECSA1
SET VALMBG=1
+14 SET VALMBCK="R"
MCSX ;
+1 QUIT
+2 ;
