IBACCWLSORT ;EDE/TPF - ACC (Automated Community Care) Encounters Sort Prompts ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;THIS ROUTINE WAS CLONED FROM ROUTINE IBCECSA BECAUSE ITS PROMPT FORMAT WAS REQUESTED
;BY THE eBIZ TEAM FOR THE ACC ENCOUNTER SORTS. FOR REFRENCE SEE OPTION: IBCE CLAIMS STATUS AWAITING
Q
;
INIT(RETURN,IBDAYSMAX,IBBILLER,IBDIV,IBSORT) ; -- init variables and list array
N DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,X,IBAUTH,IBFIRST,SCPFIELD,STATNUM
N IBSORT1,IBSORT2,IBSORT3,IBSORTOR ;TPF XINDEX THESE WERE OLD VISTA CODE WITH KILLS AT EXIT
;
ASKDAYSAGAIN ;ASK DAYS AGAIN ;TPF;IB*2*770v9
;
S VALMCNT=0
;
S IBDAYSMAX=0 ;REMOVE PROMPT BUT SET TO 0 SO FILTER DOES NOTHING. REFRENCES TO IBDAYSMAX IN LATER CODE CAN BE IGNORED.
;
AGAINSPLKUP ;ASK SPECIAL LOOKUP AGAIN ;TPF;IB*2*770v9
S IBFIRST=1
K IBDIV
N Y D GETENV^%ZOSV S ACCTSTENV=Y[("vac10apptas420.domain.ext") ;TPF;IB*2*770v8
F D Q:+$G(RETURN)!(+$G(RETURN)="ALL")!($G(VALMQUIT)) ;TPF;IB*2*770v29;EBILL-5297
.I $G(TSTIBINTEGSITE),("^528^636^589^657^"'[(U_$G(TSTIBINTEGSITE)_U)) S RETURN=1 Q ;FOR DEV TESTING ;TPF;IB*2*770v9
.E I '$G(TSTIBINTEGSITE),("^528^636^589^657^"'[(U_$P($$SITE^VASITE,U,3)_U)) S RETURN=1 Q ;TPF;IB*2*770v9 ;FR PROD AND IOC- DIVISION PROMPT IS ONLY FOR INTEGRATED SITES
.K RETURN
.D SPECLKUP^IBACCWLSPKUP(.RETURN) ;SPECIAL LOOKUP USING FIND^DIC IN FILE #364.99 ACC DIVISION ROLLUP ENTRY
.;
.Q:$G(VALMQUIT) ;TPF;IB*2*770v29;EBILL-5297
.Q:+$G(RETURN)
.I ($G(RETURN)[("-"))!($G(RETURN)[("ALL")) Q
.I '$P($G(RETURN("DILIST",0)),U) D Q
..W " ??",$C(7)
.;
;
Q:$G(VALMQUIT) ;TPF;IB*2*770v29;EBILL-5297
I $G(RETURN)[("ESCAPE"),($G(RETURN(1))=U) Q ;TPF;IB*2*770v25;EBILL-5229
I $G(RETURN)[("ESCAPE") G AGAINSPLKUP ;TPF;IB*2*770v9
;
W !
K IBSORTOR,IBSORTFIL ;TPF;IB*2*770v22;EBILL-5005
D SORT(1) I $G(VALMQUIT) Q
D SORT(2) I $G(VALMQUIT) Q
I $G(IBSORT2)'="" D SORT(3) I $G(VALMQUIT) Q
;
Q
;
EXIT ; -- exit code
K IBSORT1,IBSORT2,IBSORT3,IBSORTOR
D CLEAN^VALM10
Q
;
SORT(LVL,IBDEFSRT) ;
; 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)_".") Q
I $G(VALMQUIT) Q
;
I LVL>1,$G(IBSORT1)="" D SORT(1) I $G(IBSORT1)="" Q
I LVL=3,$G(IBSORT2)="" D SORT(2) I $G(IBSORT2)="" Q
;
S LVLD=$S(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
;
S DIR("A")=LVLD_" Sort"
I LVL=1 S DIR("B")=$$SD("E") ;TPF;CHANGE DEFAULT DEPENDENT ON SESSION KEY
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(@(SESSIONKEY)+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($P(S,":",1,2),U) ; sort code:desc pair
. S SCPFIELD=$P($P(S,":",1,2),U,2) ;THIS IS THE FIELD NAME IN ^TMP("IBACCUTIL",$J WE WILL SORT BY
. S G=$S(G="":SCP,1:G_";"_SCP)
. Q
;
S $P(DIR(0),U,2)=G
;
;TPF;IB*2*770v20;BEGIN EBILL-4631;FOR "FILTERS" ADD LEGEND
S DIR("?",1)="Enter the Sort you wish to use."
S DIR("?",2)=" "
S DIR("?",3)="* Denotes sort has an associated filter."
S DIR("?")=" "
;S DIR("B")=$TR($G(DIR("B")),"*") ;TPF;IB*2*770v22;EBILL-4998
;TPF;IB*2*770v20;END EBILL-4631;
D ^DIR K DIR
I $D(DTOUT) S VALMQUIT=1 Q ; timeout
I $D(DUOUT) S VALMQUIT=1 Q ;TPF;IB*2*770v27;EBILL-5297
I $D(DIRUT) S:LVL=1 VALMQUIT=1 Q ; ^ or nil response
S @("IBSORT"_LVL)=Y,IBZ=Y
S IBSORT(LVL,Y(0))=""
S IBSORT(LVL,"364.9 FIELD NAME",$P($$FLD3649(Y),U))=""
S IBSORT(LVL,"399 FIELD NAME",$P($$FLD399(Y),U))=""
;
I IBZ="N" D ;DAYS ON THE WORKLIST ;TPF;IB*2*770;EBILL-4631
.S IBSORT(LVL,"DAYS ON GROUP WORKLIST")="D" ;TPF;IB*2*770v17;EBILL-4736
. S IBSORTOR(IBZ)="D" ;ALWAYS DESCENDING
;
D IBSORTOR^IBACCWLSORT1(IBZ,.IBSORT,.IBSORTOR,LVL,.VALMQUIT) ;GET SORT ORDER;TPF;IB*2*770v12;EBILL-4224
;
Q
;
DISPSORTCRIT(IBSORT,VALMHDR) ;EP - CREATE SORT CRITERIA HEADER MSG
N SORTMSG,CNT,TOTAL,SORTNAME
S TOTAL=$O(IBSORT("A"),-1)
S CNT=0
F S CNT=$O(IBSORT(CNT)) Q:'CNT D
.S SORTNAME=$O(IBSORT(CNT,"A"))
.S SORTNAME=$S(SORTNAME[("SSN"):SORTNAME,SORTNAME[(" NPI"):$$TITLE^XLFSTR($P(SORTNAME," NPI"))_" NPI",1:$$TITLE^XLFSTR(SORTNAME)) ;TPF;IB*2*770v12;EBILL-4224
.S VALMHDR(2)=$G(VALMHDR(2))_" "_SORTNAME_$S(CNT'=TOTAL:",",1:"")
;
S:$G(VALMHDR(2)) VALMHDR(2)="None"
Q VALMHDR(2) ;$$LOW^XLFSTR(VALMHDR(2))
;
SD(SORT) ; sort description given the sort code letter
Q $P($P($P($T(@(SESSIONKEY_$G(SORT))),";",3),":",2),U)
;
FLD3649(SORT) ;EP - RETURN FIELD GIVEN SORT CODE LETTER
N FIELD
S FIELD=$P($P($P($P($T(@(SESSIONKEY_$G(SORT))),";",3),":",2),U,2),"|")
Q $S(FIELD'="":FIELD,1:"UNDEF")
;
FLD399(SORT) ;EP - RETURN FIELD GIVEN SORT CODE LETTER
N FIELD
S FIELD=$P($P($P($P($T(@(SESSIONKEY_$G(SORT))),";",3),":",2),U,2),"|",2)
Q $S(FIELD'="":FIELD,1:"UNDEF")
;
SV(SORT) ; sort value given the sort code letter
NEW S,VAR,VALUE
S S=$P($T(@(SESSIONKEY_$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
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:Reason Code Text:0:IBERR;
ZZN ;;N:Days on the Worklist:1:IBPEN;
ZZM ;;M:Patient Name:0:IBPAT;
ZZP ;;P:Payer:0:IBPAY;
ZZR ;;R:Review sort by STATUS:1:IBREV;
ZZL ;;L:SSN Last 4:0:IBSSN
;
IBACCSUP ;;ALLOWABLE SORTS FOR SUPERVISORS/DEVELOPERS
IBACCSUPB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;;.15|.01
IBACCSUPA ;;A:Amount Paid^PAID AMOUNT|:1:XXXXX;;.27|
IBACCSUPS ;;S:Date of Service^DATE OF SERVICE:1:IBSER;;.12|
IBACCSUPD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCSUPE ;;E:Error Code Text^REASONS:0:IBERR;;5|
IBACCSUPN ;;N:Days on Worklist^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04|
IBACCSUPM ;;M:Patient Name^PATIENT NAME:0:IBPAT;;.03|
IBACCSUPP ;;P:Payer^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17
IBACCSUPR ;;R:Review sort by STATUS:1:IBREV;;.16
;
IBACCBILL ;;ALLOWABLE SORTS FOR BILLERS
IBACCBILLA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27| ;TPF;IB*2*770v18;EBILL-4623
IBACCBILLE ;;E:Error Code Text*^REASONS:0:xxxx;;5| ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.03| ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04 ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17| ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12| ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
;
IBACCFRT ;;
IBACCFRTA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27|;TPF;IB*2*770v18;EBILL-4623
IBACCFRTB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;;.15|.01
IBACCFRTS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12| ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
IBACCFRTD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCFRTE ;;E:Error Code Text*^REASONS:0:IBERR;;5|
IBACCFRTN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04|
IBACCFRTM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02|
IBACCFRTP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17|
IBACCFRTR ;;R:Review sort by STATUS^STATUS:1:XXXXX;;.16|;TPF;IB*2*770v12;EBILL-4525
IBACCFRTL ;;L:SSN Last 4*^PATIENT SSN:1:xxxx;;.11|;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224
IBACCFRTSF ;;SF:Service Facility Name^SERVICE FACILITY:0:SERFAC;;.25|;TPF;IB*2*770v12;EBILL-4224
IBACCFRTSFN ;;SFN:Service Facility NPI^SERVICE FACILITY NPI:0:FACNPI;;.26|;TPF;IB*2*770v12;EBILL-422 ;
;
IBACCRUR ;;
IBACCRURA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27|;TPF;IB*2*770v18;EBILL-4623
IBACCRURD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCRURE ;;E:Error Code Text*^REASONS:0:IBERR;;5| ;TPF;IB*2*770v27;EBILL-5355
IBACCRURM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02| ;TPF;IB*2*770v27;EBILL-5355
IBACCRURN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04 ;TPF;IB*2*770v27;EBILL-5355
IBACCRURP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17 ;TPF;IB*2*770v27;EBILL-5355
IBACCRURPT ;;PT:Patient Type^IN-PATIENT/OUT-PATIENT|$$INPAT^IBCEF(IBIFN):0:IBACCTYPE;S INPAT=$$INPAT^IBCEF(IBIFN);.05
IBACCRURR ;;R:Review sort by STATUS^STATUS:1:XXXXX;;.16;TPF;IB*2*770v12;EBILL-4525
IBACCRURS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12 ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
IBACCRURX ;;X:Primary Diagnosis Code*^PRIMARY DX:1:XXXX;;.14 ;TPF;IB*2*770v38;EBILL-5505
;
IBACCIV ;;
IBACCIVA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27| ;TPF;IB*2*770v18;EBILL-4623
IBACCIVD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCIVE ;;E:Error Code Text*^REASONS:0:IBERR;;5| ;TPF;IB*2*770v27;EBILL-5355
IBACCIVM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02| ;TPF;IB*2*770v27;EBILL-5355
IBACCIVN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04 ;TPF;IB*2*770v27;EBILL-5355
IBACCIVP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17 ;TPF;IB*2*770v27;EBILL-5355
IBACCIVPT ;;PT:Patient Type^IN-PATIENT/OUT-PATIENT|$$INPAT^IBCEF(IBIFN):0:IBACCTYPE;S INPAT=$$INPAT^IBCEF(IBIFN);.05
IBACCIVS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12 ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
;
IBACCPTF ;;
IBACCPTFA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;,27 ;TPF;IB*2*770v18;EBILL-4623
IBACCPTFB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;;.15|.01
IBACCPTFS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12 ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
IBACCPTFD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2
IBACCPTFE ;;E:Error Code Text*^REASONS:0:IBERR;;5
IBACCPTFN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04
IBACCPTFM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02
IBACCPTFP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17
IBACCPTFR ;;R:Review sort by STATUS^STATUS:1:XXXXX;;.16| ;TPF;IB*2*770v12;EBILL-4525
IBACCPTFL ;;L:SSN^PATIENT SSN:1:xxxx;;.11| ;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224 ;MJL;IB*2*802v1;EBILL-5932
IBACCPTFSF ;;SF:Service Facility Name^SERVICE FACILITY:0:SERFAC;;.25|;TPF;IB*2*770v12;EBILL-4224
IBACCPTFSFN ;;SFN:Service Facility NPI^SERVICE FACILITY NPI:0:FACNPI;.26|;TPF;IB*2*770v12;EBILL-4224
;
;INACTIVATED SORTS
;IBACCSUPA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
;IBACCFRTPTFA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
;IBACCHIMSA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
;IBACCIVA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
;IBACCFRTA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
;ZZA ;;A:Authorizing Biller:0:IBUER;
;IBACCSUPCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
;IBACCBILLCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:IBOAM;
;IBACCRURD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;
;IBACCRURL ;;L:SSN Full^PATIENT SSN:1:xxxx;;.11| ;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224
;IBACCFRTCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
;IBACCRURCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
;IBACCIVCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
;IBACCPTFA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
;IBACCIVB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;
;IBACCIVL ;;L:SSN Last 4/ICN^PATIENT SSN:1:xxxx ;BASDED ON SSN OR ICN
;IBACCIVR ;;R:Review sort by STATUS^STATUS:1:XXXXX; ;TPF;IB*2*770v12;EBILL-4525
;IBACCRURPD ;;PD:Primary Diagnosis*^PRIMARY DX:1:XXXX;;.14 ;TPF;IB*2*770v38;EBILL-5505 6/2/2025 THEY CHANGED THE SPECS AFTER i HASD FINISHED THE FIRST ASK
;IBACCPTFL ;;L:SSN Last 4*^PATIENT SSN:1:xxxx;;.11| ;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLSORT 12738 printed May 25, 2026@12:10:10 Page 2
IBACCWLSORT ;EDE/TPF - ACC (Automated Community Care) Encounters Sort Prompts ; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;THIS ROUTINE WAS CLONED FROM ROUTINE IBCECSA BECAUSE ITS PROMPT FORMAT WAS REQUESTED
+4 ;BY THE eBIZ TEAM FOR THE ACC ENCOUNTER SORTS. FOR REFRENCE SEE OPTION: IBCE CLAIMS STATUS AWAITING
+5 QUIT
+6 ;
INIT(RETURN,IBDAYSMAX,IBBILLER,IBDIV,IBSORT) ; -- init variables and list array
+1 NEW DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,X,IBAUTH,IBFIRST,SCPFIELD,STATNUM
+2 ;TPF XINDEX THESE WERE OLD VISTA CODE WITH KILLS AT EXIT
NEW IBSORT1,IBSORT2,IBSORT3,IBSORTOR
+3 ;
ASKDAYSAGAIN ;ASK DAYS AGAIN ;TPF;IB*2*770v9
+1 ;
+2 SET VALMCNT=0
+3 ;
+4 ;REMOVE PROMPT BUT SET TO 0 SO FILTER DOES NOTHING. REFRENCES TO IBDAYSMAX IN LATER CODE CAN BE IGNORED.
SET IBDAYSMAX=0
+5 ;
AGAINSPLKUP ;ASK SPECIAL LOOKUP AGAIN ;TPF;IB*2*770v9
+1 SET IBFIRST=1
+2 KILL IBDIV
+3 ;TPF;IB*2*770v8
NEW Y
DO GETENV^%ZOSV
SET ACCTSTENV=Y[("vac10apptas420.domain.ext")
+4 ;TPF;IB*2*770v29;EBILL-5297
FOR
Begin DoDot:1
+5 ;FOR DEV TESTING ;TPF;IB*2*770v9
IF $GET(TSTIBINTEGSITE)
IF ("^528^636^589^657^"'[(U_$GET(TSTIBINTEGSITE)_U))
SET RETURN=1
QUIT
+6 ;TPF;IB*2*770v9 ;FR PROD AND IOC- DIVISION PROMPT IS ONLY FOR INTEGRATED SITES
IF '$TEST
IF '$GET(TSTIBINTEGSITE)
IF ("^528^636^589^657^"'[(U_$PIECE($$SITE^VASITE,U,3)_U))
SET RETURN=1
QUIT
+7 KILL RETURN
+8 ;SPECIAL LOOKUP USING FIND^DIC IN FILE #364.99 ACC DIVISION ROLLUP ENTRY
DO SPECLKUP^IBACCWLSPKUP(.RETURN)
+9 ;
+10 ;TPF;IB*2*770v29;EBILL-5297
if $GET(VALMQUIT)
QUIT
+11 if +$GET(RETURN)
QUIT
+12 IF ($GET(RETURN)[("-"))!($GET(RETURN)[("ALL"))
QUIT
+13 IF '$PIECE($GET(RETURN("DILIST",0)),U)
Begin DoDot:2
+14 WRITE " ??",$CHAR(7)
End DoDot:2
QUIT
+15 ;
End DoDot:1
if +$GET(RETURN)!(+$GET(RETURN)="ALL")!($GET(VALMQUIT))
QUIT
+16 ;
+17 ;TPF;IB*2*770v29;EBILL-5297
if $GET(VALMQUIT)
QUIT
+18 ;TPF;IB*2*770v25;EBILL-5229
IF $GET(RETURN)[("ESCAPE")
IF ($GET(RETURN(1))=U)
QUIT
+19 ;TPF;IB*2*770v9
IF $GET(RETURN)[("ESCAPE")
GOTO AGAINSPLKUP
+20 ;
+21 WRITE !
+22 ;TPF;IB*2*770v22;EBILL-5005
KILL IBSORTOR,IBSORTFIL
+23 DO SORT(1)
IF $GET(VALMQUIT)
QUIT
+24 DO SORT(2)
IF $GET(VALMQUIT)
QUIT
+25 IF $GET(IBSORT2)'=""
DO SORT(3)
IF $GET(VALMQUIT)
QUIT
+26 ;
+27 QUIT
+28 ;
EXIT ; -- exit code
+1 KILL IBSORT1,IBSORT2,IBSORT3,IBSORTOR
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
SORT(LVL,IBDEFSRT) ;
+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)_".")
QUIT
+6 IF $GET(VALMQUIT)
QUIT
+7 ;
+8 IF LVL>1
IF $GET(IBSORT1)=""
DO SORT(1)
IF $GET(IBSORT1)=""
QUIT
+9 IF LVL=3
IF $GET(IBSORT2)=""
DO SORT(2)
IF $GET(IBSORT2)=""
QUIT
+10 ;
+11 SET LVLD=$SELECT(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
+12 ;
+13 SET DIR("A")=LVLD_" Sort"
+14 ;TPF;CHANGE DEFAULT DEPENDENT ON SESSION KEY
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(@(SESSIONKEY)+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($PIECE(S,":",1,2),U)
+33 ;THIS IS THE FIELD NAME IN ^TMP("IBACCUTIL",$J WE WILL SORT BY
SET SCPFIELD=$PIECE($PIECE(S,":",1,2),U,2)
+34 SET G=$SELECT(G="":SCP,1:G_";"_SCP)
+35 QUIT
End DoDot:1
+36 ;
+37 SET $PIECE(DIR(0),U,2)=G
+38 ;
+39 ;TPF;IB*2*770v20;BEGIN EBILL-4631;FOR "FILTERS" ADD LEGEND
+40 SET DIR("?",1)="Enter the Sort you wish to use."
+41 SET DIR("?",2)=" "
+42 SET DIR("?",3)="* Denotes sort has an associated filter."
+43 SET DIR("?")=" "
+44 ;S DIR("B")=$TR($G(DIR("B")),"*") ;TPF;IB*2*770v22;EBILL-4998
+45 ;TPF;IB*2*770v20;END EBILL-4631;
+46 DO ^DIR
KILL DIR
+47 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+48 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)
SET VALMQUIT=1
QUIT
+49 ; ^ or nil response
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
QUIT
+50 SET @("IBSORT"_LVL)=Y
SET IBZ=Y
+51 SET IBSORT(LVL,Y(0))=""
+52 SET IBSORT(LVL,"364.9 FIELD NAME",$PIECE($$FLD3649(Y),U))=""
+53 SET IBSORT(LVL,"399 FIELD NAME",$PIECE($$FLD399(Y),U))=""
+54 ;
+55 ;DAYS ON THE WORKLIST ;TPF;IB*2*770;EBILL-4631
IF IBZ="N"
Begin DoDot:1
+56 ;TPF;IB*2*770v17;EBILL-4736
SET IBSORT(LVL,"DAYS ON GROUP WORKLIST")="D"
+57 ;ALWAYS DESCENDING
SET IBSORTOR(IBZ)="D"
End DoDot:1
+58 ;
+59 ;GET SORT ORDER;TPF;IB*2*770v12;EBILL-4224
DO IBSORTOR^IBACCWLSORT1(IBZ,.IBSORT,.IBSORTOR,LVL,.VALMQUIT)
+60 ;
+61 QUIT
+62 ;
DISPSORTCRIT(IBSORT,VALMHDR) ;EP - CREATE SORT CRITERIA HEADER MSG
+1 NEW SORTMSG,CNT,TOTAL,SORTNAME
+2 SET TOTAL=$ORDER(IBSORT("A"),-1)
+3 SET CNT=0
+4 FOR
SET CNT=$ORDER(IBSORT(CNT))
if 'CNT
QUIT
Begin DoDot:1
+5 SET SORTNAME=$ORDER(IBSORT(CNT,"A"))
+6 ;TPF;IB*2*770v12;EBILL-4224
SET SORTNAME=$SELECT(SORTNAME[("SSN"):SORTNAME,SORTNAME[(" NPI"):$$TITLE^XLFSTR($PIECE(SORTNAME," NPI"))_" NPI",1:$$TITLE^XLFSTR(SORTNAME))
+7 SET VALMHDR(2)=$GET(VALMHDR(2))_" "_SORTNAME_$SELECT(CNT'=TOTAL:",",1:"")
End DoDot:1
+8 ;
+9 if $GET(VALMHDR(2))
SET VALMHDR(2)="None"
+10 ;$$LOW^XLFSTR(VALMHDR(2))
QUIT VALMHDR(2)
+11 ;
SD(SORT) ; sort description given the sort code letter
+1 QUIT $PIECE($PIECE($PIECE($TEXT(@(SESSIONKEY_$GET(SORT))),";",3),":",2),U)
+2 ;
FLD3649(SORT) ;EP - RETURN FIELD GIVEN SORT CODE LETTER
+1 NEW FIELD
+2 SET FIELD=$PIECE($PIECE($PIECE($PIECE($TEXT(@(SESSIONKEY_$GET(SORT))),";",3),":",2),U,2),"|")
+3 QUIT $SELECT(FIELD'="":FIELD,1:"UNDEF")
+4 ;
FLD399(SORT) ;EP - RETURN FIELD GIVEN SORT CODE LETTER
+1 NEW FIELD
+2 SET FIELD=$PIECE($PIECE($PIECE($PIECE($TEXT(@(SESSIONKEY_$GET(SORT))),";",3),":",2),U,2),"|",2)
+3 QUIT $SELECT(FIELD'="":FIELD,1:"UNDEF")
+4 ;
SV(SORT) ; sort value given the sort code letter
+1 NEW S,VAR,VALUE
+2 SET S=$PIECE($TEXT(@(SESSIONKEY_$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
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:Reason Code Text:0:IBERR;
ZZN ;;N:Days on the Worklist:1:IBPEN;
ZZM ;;M:Patient Name:0:IBPAT;
ZZP ;;P:Payer:0:IBPAY;
ZZR ;;R:Review sort by STATUS:1:IBREV;
ZZL ;;L:SSN Last 4:0:IBSSN
+1 ;
IBACCSUP ;;ALLOWABLE SORTS FOR SUPERVISORS/DEVELOPERS
IBACCSUPB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;;.15|.01
IBACCSUPA ;;A:Amount Paid^PAID AMOUNT|:1:XXXXX;;.27|
IBACCSUPS ;;S:Date of Service^DATE OF SERVICE:1:IBSER;;.12|
IBACCSUPD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCSUPE ;;E:Error Code Text^REASONS:0:IBERR;;5|
IBACCSUPN ;;N:Days on Worklist^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04|
IBACCSUPM ;;M:Patient Name^PATIENT NAME:0:IBPAT;;.03|
IBACCSUPP ;;P:Payer^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17
IBACCSUPR ;;R:Review sort by STATUS:1:IBREV;;.16
+1 ;
IBACCBILL ;;ALLOWABLE SORTS FOR BILLERS
IBACCBILLA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27| ;TPF;IB*2*770v18;EBILL-4623
IBACCBILLE ;;E:Error Code Text*^REASONS:0:xxxx;;5| ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.03| ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04 ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17| ;TPF;IB*2*770v27;EBILL-5355
IBACCBILLS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12| ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
+1 ;
IBACCFRT ;;
IBACCFRTA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27|;TPF;IB*2*770v18;EBILL-4623
IBACCFRTB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;;.15|.01
IBACCFRTS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12| ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
IBACCFRTD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCFRTE ;;E:Error Code Text*^REASONS:0:IBERR;;5|
IBACCFRTN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04|
IBACCFRTM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02|
IBACCFRTP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17|
IBACCFRTR ;;R:Review sort by STATUS^STATUS:1:XXXXX;;.16|;TPF;IB*2*770v12;EBILL-4525
IBACCFRTL ;;L:SSN Last 4*^PATIENT SSN:1:xxxx;;.11|;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224
IBACCFRTSF ;;SF:Service Facility Name^SERVICE FACILITY:0:SERFAC;;.25|;TPF;IB*2*770v12;EBILL-4224
IBACCFRTSFN ;;SFN:Service Facility NPI^SERVICE FACILITY NPI:0:FACNPI;;.26|;TPF;IB*2*770v12;EBILL-422 ;
+1 ;
IBACCRUR ;;
IBACCRURA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27|;TPF;IB*2*770v18;EBILL-4623
IBACCRURD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCRURE ;;E:Error Code Text*^REASONS:0:IBERR;;5| ;TPF;IB*2*770v27;EBILL-5355
IBACCRURM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02| ;TPF;IB*2*770v27;EBILL-5355
IBACCRURN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04 ;TPF;IB*2*770v27;EBILL-5355
IBACCRURP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17 ;TPF;IB*2*770v27;EBILL-5355
IBACCRURPT ;;PT:Patient Type^IN-PATIENT/OUT-PATIENT|$$INPAT^IBCEF(IBIFN):0:IBACCTYPE;S INPAT=$$INPAT^IBCEF(IBIFN);.05
IBACCRURR ;;R:Review sort by STATUS^STATUS:1:XXXXX;;.16;TPF;IB*2*770v12;EBILL-4525
IBACCRURS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12 ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
IBACCRURX ;;X:Primary Diagnosis Code*^PRIMARY DX:1:XXXX;;.14 ;TPF;IB*2*770v38;EBILL-5505
+1 ;
IBACCIV ;;
IBACCIVA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;.27| ;TPF;IB*2*770v18;EBILL-4623
IBACCIVD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2|
IBACCIVE ;;E:Error Code Text*^REASONS:0:IBERR;;5| ;TPF;IB*2*770v27;EBILL-5355
IBACCIVM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02| ;TPF;IB*2*770v27;EBILL-5355
IBACCIVN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04 ;TPF;IB*2*770v27;EBILL-5355
IBACCIVP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17 ;TPF;IB*2*770v27;EBILL-5355
IBACCIVPT ;;PT:Patient Type^IN-PATIENT/OUT-PATIENT|$$INPAT^IBCEF(IBIFN):0:IBACCTYPE;S INPAT=$$INPAT^IBCEF(IBIFN);.05
IBACCIVS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12 ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
+1 ;
IBACCPTF ;;
IBACCPTFA ;;A:Amount Paid*^PAID AMOUNT|:1:IBOAM;;,27 ;TPF;IB*2*770v18;EBILL-4623
IBACCPTFB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;;.15|.01
IBACCPTFS ;;S:Date of Service*^SERVICE DATE:1:IBSER;;.12 ;TPF;IB*2*770v25;EBILL-4705 ADD FILTER FOR ALL WL DATE OF SERVICE
IBACCPTFD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;;.2
IBACCPTFE ;;E:Error Code Text*^REASONS:0:IBERR;;5
IBACCPTFN ;;N:Days on Worklist*^DAYS ON GROUP WORKLIST:1:IBPEN;;3.04
IBACCPTFM ;;M:Patient Name*^PATIENT NAME:0:IBPAT;;.02
IBACCPTFP ;;P:Payer*^PRIMARY INS|$$CURR~IBCEF2(IBIFN):0:IBPAY;;.17
IBACCPTFR ;;R:Review sort by STATUS^STATUS:1:XXXXX;;.16| ;TPF;IB*2*770v12;EBILL-4525
IBACCPTFL ;;L:SSN^PATIENT SSN:1:xxxx;;.11| ;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224 ;MJL;IB*2*802v1;EBILL-5932
IBACCPTFSF ;;SF:Service Facility Name^SERVICE FACILITY:0:SERFAC;;.25|;TPF;IB*2*770v12;EBILL-4224
IBACCPTFSFN ;;SFN:Service Facility NPI^SERVICE FACILITY NPI:0:FACNPI;.26|;TPF;IB*2*770v12;EBILL-4224
+1 ;
+2 ;INACTIVATED SORTS
+3 ;IBACCSUPA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
+4 ;IBACCFRTPTFA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
+5 ;IBACCHIMSA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
+6 ;IBACCIVA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
+7 ;IBACCFRTA ;;A:Authorizing Biller^|AUTHORIZER:0:IBUER;
+8 ;ZZA ;;A:Authorizing Biller:0:IBUER;
+9 ;IBACCSUPCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
+10 ;IBACCBILLCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:IBOAM;
+11 ;IBACCRURD ;;D:Division^SITE NUMBER|DEFAULT DIVISION:0:IBDIV;
+12 ;IBACCRURL ;;L:SSN Full^PATIENT SSN:1:xxxx;;.11| ;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224
+13 ;IBACCFRTCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
+14 ;IBACCRURCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
+15 ;IBACCIVCA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
+16 ;IBACCPTFA ;;CA:Claim Amount^|TOTAL CHARGES-OFFSET AMOUNT:1:XXXXX;
+17 ;IBACCIVB ;;B:Bill Number^X12 CLAIM NUMBER|BILL NUMBER:0:IB;
+18 ;IBACCIVL ;;L:SSN Last 4/ICN^PATIENT SSN:1:xxxx ;BASDED ON SSN OR ICN
+19 ;IBACCIVR ;;R:Review sort by STATUS^STATUS:1:XXXXX; ;TPF;IB*2*770v12;EBILL-4525
+20 ;IBACCRURPD ;;PD:Primary Diagnosis*^PRIMARY DX:1:XXXX;;.14 ;TPF;IB*2*770v38;EBILL-5505 6/2/2025 THEY CHANGED THE SPECS AFTER i HASD FINISHED THE FIRST ASK
+21 ;IBACCPTFL ;;L:SSN Last 4*^PATIENT SSN:1:xxxx;;.11| ;BASED ON SSN;TPF;IB*2*770v12;EBILL-4224
