IBCECSA ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;28-JUL-1999
;;2.0;INTEGRATED BILLING;**137,320,623,650**;21-MAR-1994;Build 21
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for claims status awaiting resolution
N IBSORT,IBSORT1,IBSORT2,IBSORT3,IBSORTOR,IBDAYS,INFOSTDT,INFOENDT ;WCJ;IB*2.0*650;added a date range for informational messages
D EN^VALM("IBCEM CSA LIST")
Q
;
HDR ; -- header code
;/vd - IB*2.0*623 (US141) - Instituted the IBHDSORT variable to determine what the Header should be based on the user's selection.
N IBHDSORT
S IBHDSORT=$G(^TMP("IBRTYP",$J,0))
S VALMHDR(1)=$S(IBHDSORT="N":"Non-",IBHDSORT="B":"MCCF and Non-",1:"")_"MCCF Claims"
S VALMSG="* Indicates CSA review in progress"
Q
;
INIT ; -- init variables and list array
N DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,X,IBFIRST
K ^TMP("IBBIL",$J),^TMP("IBDIV",$J),VALMQUIT
S VALMCNT=0
;
S DIR(0)="NA^0:999",DIR("B")=0,DIR("A")="MINIMUM # OF DAYS MSGS WAITING TO BE RESOLVED: ",DIR("?")="Enter the minimum number of days you want a message to have been waiting to be resolved before it will be displayed on this screen."
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
S IBDAYS=Y
;
S IBFIRST=1
F S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")=$S(IBFIRST:"",1:" Another ")_"AUTHORIZING BILLER: "_$S(IBFIRST:"ALL// ",1:"") D ^DIC K DIC Q:Y<0 D
. I $D(^TMP("IBBIL",$J,+Y)) W !,"This biller has already been selected" Q
. S ^TMP("IBBIL",$J,+Y)="",IBFIRST=0
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
;
S IBFIRST=1
F S DIC="^DG(40.8,",DIC(0)="AEQMN",DIC("A")=$S(IBFIRST:"",1:" Another ")_"DIVISION: "_$S(IBFIRST:"ALL//",1:"") D ^DIC K DIC Q:Y<0 S ^TMP("IBDIV",$J,+Y)="",IBFIRST=0
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
;
;/vd - IB*2.0*623 (US141) Beginning - Ask to Search by MCCF, Non-MCCf or Both
K ^TMP("IBRTYP",$J)
W !
S DIR(0)="SA^M:MCCF;N:Non-MCCF;B:Both"
S DIR("A")="Search by (M)CCF, (N)on-MCCF, or (B)oth? "
S DIR("B")="M"
S DIR("?",1)="Select one of the following:"
S DIR("?",2)=" M MCCF Claims Only"
S DIR("?",3)=" N Non-MCCF Claims Only"
S DIR("?",4)=" B MCCF and Non-MCCF Claims"
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
S ^TMP("IBRTYP",$J,0)=Y
;/vd - IB*2.0*623 (US141) End.
;
; IB*320 - new sorting
W !
K IBSORTOR
D SORT(1) I $G(VALMQUIT) G INITQ
D SORT(2) I $G(VALMQUIT) G INITQ
I $G(IBSORT2)'="" D SORT(3) I $G(VALMQUIT) G INITQ
;
S DIR(0)="SA^R:REJECTS ONLY;B:BOTH INFORMATIONAL AND REJECTS"
S DIR("A")="(R)ejects only OR (B)oth informational and rejects?: "
S DIR("?",1)="YOU MAY CHOOSE TO SEE JUST THOSE MESSAGES WE KNOW ARE REJECTS OR YOU MAY"
S DIR("?")=" CHOOSE TO SEE ALL MESSAGES MEETING YOUR SELECTION CRITERIA",DIR("B")="REJECTS ONLY"
W !! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
S IBSEV=Y
;
;WCJ;IB*2.0*650;limit date range when biller chooses (B)oth - first ask for range here
DATES I IBSEV="B" D I $D(DTOUT)!$D(DUOUT) G INITQ
. N DIR
. S DIR(0)="DAO^:DT:EX" ; limit from beginning of time to today
. S DIR("B")="T-1"
. S DIR("A")="First Date Received: "
. S DIR("?")="Enter the starting message received date."
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 Q
. S INFOSTDT=Y
. K DIR
. S DIR(0)="DAO^"_INFOSTDT_":DT:EX" ;limit from start day to today
. S DIR("B")="T"
. S DIR("A")="Last Date Received: "
. S DIR("?")="Enter the ending message received date. Cannot be before starting date."
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 Q
. S INFOENDT=Y
. K DIR
;
D BLD^IBCECSA1
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
S VALMSG="* Indicates review in progress"
Q
;
EXIT ; -- exit code
K IBDAYS,IBSORT1,IBSORT2,IBSORT3,IBSORTOR
K ^TMP("IBCECSA",$J),^TMP("IBDIV",$J),^TMP("IBBIL",$J)
K ^TMP("IBCECSB",$J),^TMP("IBCECSC",$J),^TMP("IBCECSD",$J)
K ^TMP("IBRTYP",$J) ;/vd - IB*2.0*623 (US141)
D CLEAN^VALM10
Q
;
SORT(LVL,IBDEFSRT) ; CSA sort
; LVL - sort level 1,2,or,3
; IBDEFSRT - default sort value (optional)
NEW DIR,X,Y,LVLD,G,LN,S,SC,SCP,DTOUT,DUOUT,DIRUT,DIROUT,IBZ
K IBSORT3 I LVL<3 K IBSORT2 I LVL=1 K IBSORT1
I '$F(".1.2.3.","."_$G(LVL)_".") G SORTX
I $G(VALMQUIT) G SORTX
;
I LVL>1,$G(IBSORT1)="" D SORT(1) I $G(IBSORT1)="" G SORTX
I LVL=3,$G(IBSORT2)="" D SORT(2) I $G(IBSORT2)="" G SORTX
;
S LVLD=$S(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
;
S DIR("A")=LVLD_" Sort"
I LVL=1 S DIR("B")=$$SD("E")
I LVL>1 K DIR("B")
I LVL=2,IBSORT1=$G(IBDEFSRT) K IBDEFSRT
I LVL=3,IBSORT1=$G(IBDEFSRT)!(IBSORT2=$G(IBDEFSRT)) K IBDEFSRT
I $G(IBDEFSRT)'="" S DIR("B")=$$SD(IBDEFSRT) ; passed in default sort
;
S DIR("?")="Enter a code from the list to indicate the "_LVLD_" sort order."
I LVL>1 S DIR("?",1)=" Primary Sort is "_$$SD($G(IBSORT1)),DIR("?",LVL)=""
I LVL=3 S DIR("?",2)="Secondary Sort is "_$$SD($G(IBSORT2))
;
I LVL=1 S DIR(0)="SB" ; primary sort required
I LVL>1 S DIR(0)="SOB" ; optional sorts
;
S G=""
F LN=1:1 S S=$P($T(ZZ+LN),";",3) Q:S="" D
. S SC=$P(S,":",1) ; sort code letter
. I LVL=2,IBSORT1=SC Q
. I LVL=3,IBSORT1=SC!(IBSORT2=SC) Q
. S SCP=$P(S,":",1,2) ; sort code:desc pair
. S G=$S(G="":SCP,1:G_";"_SCP)
. Q
;
S $P(DIR(0),U,2)=G
;
D ^DIR K DIR
I $D(DTOUT) S VALMQUIT=1 G SORTX ; timeout
I $D(DIRUT) S:LVL=1 VALMQUIT=1 G SORTX ; ^ or nil response
S @("IBSORT"_LVL)=Y,IBZ=Y
;
I IBZ="N" D G SORTX ; number of days pending
. S IBSORTOR(IBZ)="D" ; this sort is always descending
. Q
;
I IBZ="C" D G SORTX ; current balance question
. S DIR(0)="Y"
. S DIR("A")="Display Highest Balances First",DIR("B")="Yes"
. S DIR("A",1)=""
. S DIR("?",1)="Enter Yes or No."
. S DIR("?",2)=""
. S DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
. S DIR("?",4)="small balances last at the bottom of the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
. S DIR("?")="large balances last at the bottom of the list."
. D ^DIR K DIR
. I $D(DTOUT) S VALMQUIT=1 Q ; timeout
. I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="D" ; yes, large first, descending
. I 'Y S IBSORTOR(IBZ)="A" ; no, small first, ascending
. Q
;
I IBZ="S" D G SORTX ; Date of Service question
. S DIR(0)="Y"
. S DIR("A")="Display Oldest Claims First",DIR("B")="Yes"
. S DIR("A",1)=""
. S DIR("?",1)="Enter Yes or No."
. S DIR("?",2)=""
. S DIR("?",3)="Yes, I want to see claims with old dates of service at the top of the list"
. S DIR("?",4)="and claims with recent dates of service at the bottom of the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to see claims with recent dates of service at the top of the list"
. S DIR("?")="and older claims at the bottom of the list."
. D ^DIR K DIR
. I $D(DTOUT) S VALMQUIT=1 Q ; timeout
. I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="A" ; yes, old first, ascending sort
. I 'Y S IBSORTOR(IBZ)="D" ; no, new first, descending sort
. Q
;
I IBZ="R" D G SORTX ; review status question
. S DIR(0)="Y"
. S DIR("A")="Display 'Review in Process' Messages Last",DIR("B")="Yes"
. S DIR("A",1)=""
. S DIR("?",1)="Enter Yes or No."
. S DIR("?",2)=""
. S DIR("?",3)="Yes, I want to group together status messages under review at the bottom of"
. S DIR("?",4)="the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to group together status messages under review at the top of the"
. S DIR("?")="list."
. D ^DIR K DIR
. I $D(DTOUT) S VALMQUIT=1 Q ; timeout
. I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="A" ; yes, 1 at bottom, 0 at top, ascending
. I 'Y S IBSORTOR(IBZ)="D" ; no, 1 at top, 0 at bottom, descending
. Q
;
SORTX ;
Q
;
SD(SORT) ; sort description given the sort code letter
Q $P($P($T(@("ZZ"_$G(SORT))),";",3),":",2)
;
SV(SORT) ; sort value given the sort code letter
NEW S,VAR,VALUE
S S=$P($T(@("ZZ"_$G(SORT))),";",3)
S VAR=$P(S,":",4) ; variable name
S VALUE=$G(@VAR) ; value of variable
I VALUE="" S VALUE="~" G SVX ; get out if undefined
I '$P(S,":",3) G SVX ; non-numeric
I $G(IBSORTOR(SORT))="D" S VALUE=-VALUE ; descending sort
SVX Q VALUE
;
ZZ ; List of allowable sort criteria
ZZA ;;A:Authorizing Biller:0:IBUER;
ZZB ;;B:Bill Number:0:IB;
ZZC ;;C:Current Balance:1:IBOAM;
ZZS ;;S:Date of Service:1:IBSER;
ZZD ;;D:Division:0:IBDIV;
ZZE ;;E:Error Code Text:0:IBERR;
ZZN ;;N:Number of Days Pending:1:IBPEN;
ZZM ;;M:Patient Name:0:IBPAT;
ZZP ;;P:Payer:0:IBPAY;
ZZR ;;R:Review in Process:1:IBREV;
ZZL ;;L:SSN Last 4:0:IBSSN;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECSA 8941 printed Apr 09, 2024@21:29:24 Page 2
IBCECSA ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;28-JUL-1999
+1 ;;2.0;INTEGRATED BILLING;**137,320,623,650**;21-MAR-1994;Build 21
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for claims status awaiting resolution
+1 ;WCJ;IB*2.0*650;added a date range for informational messages
NEW IBSORT,IBSORT1,IBSORT2,IBSORT3,IBSORTOR,IBDAYS,INFOSTDT,INFOENDT
+2 DO EN^VALM("IBCEM CSA LIST")
+3 QUIT
+4 ;
HDR ; -- header code
+1 ;/vd - IB*2.0*623 (US141) - Instituted the IBHDSORT variable to determine what the Header should be based on the user's selection.
+2 NEW IBHDSORT
+3 SET IBHDSORT=$GET(^TMP("IBRTYP",$JOB,0))
+4 SET VALMHDR(1)=$SELECT(IBHDSORT="N":"Non-",IBHDSORT="B":"MCCF and Non-",1:"")_"MCCF Claims"
+5 SET VALMSG="* Indicates CSA review in progress"
+6 QUIT
+7 ;
INIT ; -- init variables and list array
+1 NEW DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,X,IBFIRST
+2 KILL ^TMP("IBBIL",$JOB),^TMP("IBDIV",$JOB),VALMQUIT
+3 SET VALMCNT=0
+4 ;
+5 SET DIR(0)="NA^0:999"
SET DIR("B")=0
SET DIR("A")="MINIMUM # OF DAYS MSGS WAITING TO BE RESOLVED: "
SET DIR("?")="Enter the minimum number of days you want a message to have been waiting to be resolved before it will be displayed on this screen."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+8 SET IBDAYS=Y
+9 ;
+10 SET IBFIRST=1
+11 FOR
SET DIC="^VA(200,"
SET DIC(0)="AEQM"
SET DIC("A")=$SELECT(IBFIRST:"",1:" Another ")_"AUTHORIZING BILLER: "_$SELECT(IBFIRST:"ALL// ",1:"")
DO ^DIC
KILL DIC
if Y<0
QUIT
Begin DoDot:1
+12 IF $DATA(^TMP("IBBIL",$JOB,+Y))
WRITE !,"This biller has already been selected"
QUIT
+13 SET ^TMP("IBBIL",$JOB,+Y)=""
SET IBFIRST=0
End DoDot:1
+14 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+15 ;
+16 SET IBFIRST=1
+17 FOR
SET DIC="^DG(40.8,"
SET DIC(0)="AEQMN"
SET DIC("A")=$SELECT(IBFIRST:"",1:" Another ")_"DIVISION: "_$SELECT(IBFIRST:"ALL//",1:"")
DO ^DIC
KILL DIC
if Y<0
QUIT
SET ^TMP("IBDIV",$JOB,+Y)=""
SET IBFIRST=0
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+19 ;
+20 ;/vd - IB*2.0*623 (US141) Beginning - Ask to Search by MCCF, Non-MCCf or Both
+21 KILL ^TMP("IBRTYP",$JOB)
+22 WRITE !
+23 SET DIR(0)="SA^M:MCCF;N:Non-MCCF;B:Both"
+24 SET DIR("A")="Search by (M)CCF, (N)on-MCCF, or (B)oth? "
+25 SET DIR("B")="M"
+26 SET DIR("?",1)="Select one of the following:"
+27 SET DIR("?",2)=" M MCCF Claims Only"
+28 SET DIR("?",3)=" N Non-MCCF Claims Only"
+29 SET DIR("?",4)=" B MCCF and Non-MCCF Claims"
+30 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+31 SET ^TMP("IBRTYP",$JOB,0)=Y
+32 ;/vd - IB*2.0*623 (US141) End.
+33 ;
+34 ; IB*320 - new sorting
+35 WRITE !
+36 KILL IBSORTOR
+37 DO SORT(1)
IF $GET(VALMQUIT)
GOTO INITQ
+38 DO SORT(2)
IF $GET(VALMQUIT)
GOTO INITQ
+39 IF $GET(IBSORT2)'=""
DO SORT(3)
IF $GET(VALMQUIT)
GOTO INITQ
+40 ;
+41 SET DIR(0)="SA^R:REJECTS ONLY;B:BOTH INFORMATIONAL AND REJECTS"
+42 SET DIR("A")="(R)ejects only OR (B)oth informational and rejects?: "
+43 SET DIR("?",1)="YOU MAY CHOOSE TO SEE JUST THOSE MESSAGES WE KNOW ARE REJECTS OR YOU MAY"
+44 SET DIR("?")=" CHOOSE TO SEE ALL MESSAGES MEETING YOUR SELECTION CRITERIA"
SET DIR("B")="REJECTS ONLY"
+45 WRITE !!
DO ^DIR
KILL DIR
+46 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+47 SET IBSEV=Y
+48 ;
+49 ;WCJ;IB*2.0*650;limit date range when biller chooses (B)oth - first ask for range here
DATES IF IBSEV="B"
Begin DoDot:1
+1 NEW DIR
+2 ; limit from beginning of time to today
SET DIR(0)="DAO^:DT:EX"
+3 SET DIR("B")="T-1"
+4 SET DIR("A")="First Date Received: "
+5 SET DIR("?")="Enter the starting message received date."
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
QUIT
+8 SET INFOSTDT=Y
+9 KILL DIR
+10 ;limit from start day to today
SET DIR(0)="DAO^"_INFOSTDT_":DT:EX"
+11 SET DIR("B")="T"
+12 SET DIR("A")="Last Date Received: "
+13 SET DIR("?")="Enter the ending message received date. Cannot be before starting date."
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
QUIT
+16 SET INFOENDT=Y
+17 KILL DIR
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO INITQ
+18 ;
+19 DO BLD^IBCECSA1
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 SET VALMSG="* Indicates review in progress"
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 KILL IBDAYS,IBSORT1,IBSORT2,IBSORT3,IBSORTOR
+2 KILL ^TMP("IBCECSA",$JOB),^TMP("IBDIV",$JOB),^TMP("IBBIL",$JOB)
+3 KILL ^TMP("IBCECSB",$JOB),^TMP("IBCECSC",$JOB),^TMP("IBCECSD",$JOB)
+4 ;/vd - IB*2.0*623 (US141)
KILL ^TMP("IBRTYP",$JOB)
+5 DO CLEAN^VALM10
+6 QUIT
+7 ;
SORT(LVL,IBDEFSRT) ; CSA sort
+1 ; LVL - sort level 1,2,or,3
+2 ; IBDEFSRT - default sort value (optional)
+3 NEW DIR,X,Y,LVLD,G,LN,S,SC,SCP,DTOUT,DUOUT,DIRUT,DIROUT,IBZ
+4 KILL IBSORT3
IF LVL<3
KILL IBSORT2
IF LVL=1
KILL IBSORT1
+5 IF '$FIND(".1.2.3.","."_$GET(LVL)_".")
GOTO SORTX
+6 IF $GET(VALMQUIT)
GOTO SORTX
+7 ;
+8 IF LVL>1
IF $GET(IBSORT1)=""
DO SORT(1)
IF $GET(IBSORT1)=""
GOTO SORTX
+9 IF LVL=3
IF $GET(IBSORT2)=""
DO SORT(2)
IF $GET(IBSORT2)=""
GOTO SORTX
+10 ;
+11 SET LVLD=$SELECT(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
+12 ;
+13 SET DIR("A")=LVLD_" Sort"
+14 IF LVL=1
SET DIR("B")=$$SD("E")
+15 IF LVL>1
KILL DIR("B")
+16 IF LVL=2
IF IBSORT1=$GET(IBDEFSRT)
KILL IBDEFSRT
+17 IF LVL=3
IF IBSORT1=$GET(IBDEFSRT)!(IBSORT2=$GET(IBDEFSRT))
KILL IBDEFSRT
+18 ; passed in default sort
IF $GET(IBDEFSRT)'=""
SET DIR("B")=$$SD(IBDEFSRT)
+19 ;
+20 SET DIR("?")="Enter a code from the list to indicate the "_LVLD_" sort order."
+21 IF LVL>1
SET DIR("?",1)=" Primary Sort is "_$$SD($GET(IBSORT1))
SET DIR("?",LVL)=""
+22 IF LVL=3
SET DIR("?",2)="Secondary Sort is "_$$SD($GET(IBSORT2))
+23 ;
+24 ; primary sort required
IF LVL=1
SET DIR(0)="SB"
+25 ; optional sorts
IF LVL>1
SET DIR(0)="SOB"
+26 ;
+27 SET G=""
+28 FOR LN=1:1
SET S=$PIECE($TEXT(ZZ+LN),";",3)
if S=""
QUIT
Begin DoDot:1
+29 ; sort code letter
SET SC=$PIECE(S,":",1)
+30 IF LVL=2
IF IBSORT1=SC
QUIT
+31 IF LVL=3
IF IBSORT1=SC!(IBSORT2=SC)
QUIT
+32 ; sort code:desc pair
SET SCP=$PIECE(S,":",1,2)
+33 SET G=$SELECT(G="":SCP,1:G_";"_SCP)
+34 QUIT
End DoDot:1
+35 ;
+36 SET $PIECE(DIR(0),U,2)=G
+37 ;
+38 DO ^DIR
KILL DIR
+39 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
GOTO SORTX
+40 ; ^ or nil response
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
GOTO SORTX
+41 SET @("IBSORT"_LVL)=Y
SET IBZ=Y
+42 ;
+43 ; number of days pending
IF IBZ="N"
Begin DoDot:1
+44 ; this sort is always descending
SET IBSORTOR(IBZ)="D"
+45 QUIT
End DoDot:1
GOTO SORTX
+46 ;
+47 ; current balance question
IF IBZ="C"
Begin DoDot:1
+48 SET DIR(0)="Y"
+49 SET DIR("A")="Display Highest Balances First"
SET DIR("B")="Yes"
+50 SET DIR("A",1)=""
+51 SET DIR("?",1)="Enter Yes or No."
+52 SET DIR("?",2)=""
+53 SET DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
+54 SET DIR("?",4)="small balances last at the bottom of the list."
+55 SET DIR("?",5)=""
+56 SET DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
+57 SET DIR("?")="large balances last at the bottom of the list."
+58 DO ^DIR
KILL DIR
+59 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+60 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+61 ; yes, large first, descending
IF Y
SET IBSORTOR(IBZ)="D"
+62 ; no, small first, ascending
IF 'Y
SET IBSORTOR(IBZ)="A"
+63 QUIT
End DoDot:1
GOTO SORTX
+64 ;
+65 ; Date of Service question
IF IBZ="S"
Begin DoDot:1
+66 SET DIR(0)="Y"
+67 SET DIR("A")="Display Oldest Claims First"
SET DIR("B")="Yes"
+68 SET DIR("A",1)=""
+69 SET DIR("?",1)="Enter Yes or No."
+70 SET DIR("?",2)=""
+71 SET DIR("?",3)="Yes, I want to see claims with old dates of service at the top of the list"
+72 SET DIR("?",4)="and claims with recent dates of service at the bottom of the list."
+73 SET DIR("?",5)=""
+74 SET DIR("?",6)="No, I want to see claims with recent dates of service at the top of the list"
+75 SET DIR("?")="and older claims at the bottom of the list."
+76 DO ^DIR
KILL DIR
+77 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+78 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+79 ; yes, old first, ascending sort
IF Y
SET IBSORTOR(IBZ)="A"
+80 ; no, new first, descending sort
IF 'Y
SET IBSORTOR(IBZ)="D"
+81 QUIT
End DoDot:1
GOTO SORTX
+82 ;
+83 ; review status question
IF IBZ="R"
Begin DoDot:1
+84 SET DIR(0)="Y"
+85 SET DIR("A")="Display 'Review in Process' Messages Last"
SET DIR("B")="Yes"
+86 SET DIR("A",1)=""
+87 SET DIR("?",1)="Enter Yes or No."
+88 SET DIR("?",2)=""
+89 SET DIR("?",3)="Yes, I want to group together status messages under review at the bottom of"
+90 SET DIR("?",4)="the list."
+91 SET DIR("?",5)=""
+92 SET DIR("?",6)="No, I want to group together status messages under review at the top of the"
+93 SET DIR("?")="list."
+94 DO ^DIR
KILL DIR
+95 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+96 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+97 ; yes, 1 at bottom, 0 at top, ascending
IF Y
SET IBSORTOR(IBZ)="A"
+98 ; no, 1 at top, 0 at bottom, descending
IF 'Y
SET IBSORTOR(IBZ)="D"
+99 QUIT
End DoDot:1
GOTO SORTX
+100 ;
SORTX ;
+1 QUIT
+2 ;
SD(SORT) ; sort description given the sort code letter
+1 QUIT $PIECE($PIECE($TEXT(@("ZZ"_$GET(SORT))),";",3),":",2)
+2 ;
SV(SORT) ; sort value given the sort code letter
+1 NEW S,VAR,VALUE
+2 SET S=$PIECE($TEXT(@("ZZ"_$GET(SORT))),";",3)
+3 ; variable name
SET VAR=$PIECE(S,":",4)
+4 ; value of variable
SET VALUE=$GET(@VAR)
+5 ; get out if undefined
IF VALUE=""
SET VALUE="~"
GOTO SVX
+6 ; non-numeric
IF '$PIECE(S,":",3)
GOTO SVX
+7 ; descending sort
IF $GET(IBSORTOR(SORT))="D"
SET VALUE=-VALUE
SVX QUIT VALUE
+1 ;
ZZ ; List of allowable sort criteria
ZZA ;;A:Authorizing Biller:0:IBUER;
ZZB ;;B:Bill Number:0:IB;
ZZC ;;C:Current Balance:1:IBOAM;
ZZS ;;S:Date of Service:1:IBSER;
ZZD ;;D:Division:0:IBDIV;
ZZE ;;E:Error Code Text:0:IBERR;
ZZN ;;N:Number of Days Pending:1:IBPEN;
ZZM ;;M:Patient Name:0:IBPAT;
ZZP ;;P:Payer:0:IBPAY;
ZZR ;;R:Review in Process:1:IBREV;
ZZL ;;L:SSN Last 4:0:IBSSN;
+1 ;
