- 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 23, 2025@18:24:19 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 ;
