IBACCWLSORT1 ;EDE/TPF - ACC (Automated Community Care) Encounters Sort Global Sets ; 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 ENCOUNTERS
Q
;
;CALLED FROM PULL3649^IBACCWL1
SORTSET(RETURN,ENCIENS,BILLRETURN,IBIFN,RETURNREC) ;EP - SORT THE FIELD DATA PULLED BY THE USER'S SORT AND FILTER SETTINGS
;IBSORT(1,"364.9 FIELD NAME","REASONS")=""
;IBSORT(1,"399 FIELD NAME","UNDEF")=""
;IBSORT(1,"Reason Not AutoBilled")=""
;IBSORT(2,"364.9 FIELD NAME","SERVICE DATE")=""
;IBSORT(2,"399 FIELD NAME","UNDEF")=""
;IBSORT(2,"Date of Service")=""
;IBSORT(2,"YES")="D"
;IBSORT(3,"364.9 FIELD NAME","DAYS ON WORKLIST")=""
;IBSORT(3,"399 FIELD NAME","UNDEF")=""
;IBSORT(3,"Days on the Worklist")=""
;
;IBSORT(1,"364.9 FIELD NAME","X12 CLAIM NUMBER")=""
;IBSORT(1,"399 FIELD NAME","BILL NUMBER")=""
;IBSORT(1,"Bill Number")=""
;IBSORTOR(1)="D"
;
N FIELD3649,FIELD399,FLDORD,IBSORTED1,IBSORTED2,IBSORTED3,ORDER3649,ORDER399,PAIDAMT,PATNAME,PAYERPTR,VAR
;
F FLDORD=1:1:3 S VAR="IBSORTED"_FLDORD,@VAR@(FLDORD)="UNDEF"
;
S FLDORD=0
F S FLDORD=$O(IBSORT(FLDORD)) Q:'FLDORD D
.S FIELD3649=$O(IBSORT(FLDORD,"364.9 FIELD NAME",""))
.S FIELD399=$O(IBSORT(FLDORD,"399 FIELD NAME",""))
.S ORDER3649=$G(IBSORT(FLDORD,FIELD3649))
.S ORDER399=$G(IBSORT(FLDORD,FIELD399))
.S:FIELD3649="" FIELD3649="UNDEF"
.S:FIELD399="" FIELD399="UNDEF"
.S VAR="IBSORTED"_FLDORD
.;
.I FIELD3649="PATIENT SSN" D Q ;TPF;IB*2*770v18;EBILL-4623
..I $P(VALMDDF("SSN"),U,3)=9 D ;NO NEED TO SPACE PREFIX THE SORT ON FULL SSN
...S @VAR@(FLDORD)=$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"E"),"UNDEF")
..E S @VAR@(FLDORD)=" "_$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"E"))
..S:@VAR@(FLDORD)=" " @VAR@(FLDORD)=""
.;
.I FIELD3649="SERVICE DATE" D Q ;TPF;IB*2*770v17;EBILL-4736
..S @VAR@(FLDORD)=$S(ORDER3649="A":"-",1:"")_$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF") ;TPF;IB*2*770v8;EBILL-4440
.;
.I FIELD3649="DAYS ON GROUP WORKLIST" D Q ;TPF;IB*2*770v17;EBILL-4736
..S @VAR@(FLDORD)=$S(ORDER3649="D":"-",1:"")_$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I")) ;TPF;IB*2*770v8;EBILL-
.;
.I FIELD3649="SERVICE FACILITY NPI" D Q ;TPF;IB*2*770v8;EBILL-4224
..S @VAR@(FLDORD)=$S(ORDER3649="D":"-",1:"")_$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF")
.;
.I FIELD3649="STATUS" D Q
..N S1 S S1="IBACCUTIL" ;WCJ
..S @VAR@(FLDORD)=$S(ORDER3649="D"&$G(^TMP(S1,$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"))=1:"00",ORDER3649="A"&$G(^TMP(S1,$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"))=1:"-1",1:$G(^TMP(S1,$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF"))
.;
.I FIELD3649="PATIENT NAME" D Q
..S PATNAME=$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT LAST NAME","E"))_", "_$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT FIRST NAME","E"))_" "_$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT MIDDLE NAME","E"))
..S @VAR@(FLDORD)=$G(PATNAME)
.;
.I FIELD3649="PAID AMOUNT" D Q
..I ORDER3649="D" S PAIDAMT=-$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PAID AMOUNT","E"))
..E S PAIDAMT=+$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PAID AMOUNT","E"))
..S @VAR@(FLDORD)=$G(PAIDAMT)
.;
.;TPF;IB*2*770v25;BEGIN EBILL-5133
.I FIELD3649="SITE NUMBER" D Q
..N SITEIEN,SITENAME
..S SITEIEN=$$LKUP^XUAF4($G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"E")))
..S SITENAME=$P($$NNT^XUAF4(SITEIEN),U)
..S @VAR@(FLDORD)=SITENAME
.;TPF;IB*2*770v25;END EBILL-5133
.;
.I FIELD3649="PRIMARY DX" D Q ;TPF;IB*2*770v38;EBILL-5505
..I ORDER3649="A" D
...S @VAR@(FLDORD)=$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF")
..E D
...S @VAR@(FLDORD)=$$INVERT^IBACCWLSORT1($G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF"))
.;
.I FIELD3649'="" S @VAR@(FLDORD)=$G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,FIELD3649,"E"))
.;
.I $G(IBIFN) D BILL399OVER(RETURNREC)
.;
.Q:$G(FIELD399)="UNDEF"!('IBIFN)
.;
.;IF 399 HAS A FIELD DEFINED ITS VALUE TAKES PRECEDENCE OVER A VALUE FOUND IN 364.9
.;
.I FIELD399="$$CURR~IBCEF2(IBIFN)" D Q ;PAYER
..S PAYERPTR=$$CURR^IBCEF2(IBIFN)
..I PAYERPTR S @VAR@(FLDORD)=$$GET1^DIQ(36,PAYERPTR_",",.01)
.;
.I FIELD399="$$INPAT^IBCEF(IBIFN)" D Q
..S @VAR@(FLDORD)=$$INPAT^IBCEF(IBIFN)
.;
.I FIELD399'="" S @VAR@(FLDORD)=$G(BILLRETURN(399,IBIFN_",",FIELD399,"E"))
;
F FLDORD=1:1:3 S VAR="IBSORTED"_FLDORD I @VAR@(FLDORD)="" S @VAR@(FLDORD)="z " ;IF NO DATA FOUND ;TPF;IB*2*770v11;EBIL-???? UNDEF SORT WRONG 'Z' DOES NOT DISPLAY
;
I $G(IBIFN) I $$TRANSMITTED^IBACCWLUTIL1(IBIFN) D UPDSTATUS^IBACCWLUTIL(+ENCIENS,"CLOSED") Q
;
I $G(IBIFN) M ^TMP("IBACCUTIL",$J,"K# SORTED",IBSORTED1(1),IBSORTED2(2),IBSORTED3(3))=^TMP("IBACCUTIL",$J,RETURNREC)
E M ^TMP("IBACCUTIL",$J,"NO K# SORTED",IBSORTED1(1),IBSORTED2(2),IBSORTED3(3))=^TMP("IBACCUTIL",$J,RETURNREC)
;
Q
;
;S STR="TESTSTRING" W $$INVERT^IBACCWLSORT1(STR)
INVERT(STR) ;EP - INVERT STRING FOR REVERSE SORT - USED FOR DX
N CHAR,RESULT
S RESULT=""
F CHAR=1:1:$LENGTH(STR) D
.S RESULT=RESULT_$C(255-$A($E(STR,CHAR)))
Q RESULT
;
;THERE IS NOT ENOUGH DATA AT THIS TIME 5/8/2024 TO REALLY MAKE A GOOD DECISION ABOUT OVERWRITING ALL OF THESE FIELDS
BILL399OVER(RETURNREC) ;EP - 399 DATA OVERRIDES 364.9
N IBIFNIENS,PATPTR,PATSSN,PRIMINS,SECINS
;
S IBIFNIENS=IBIFN_","
S ^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PRIMARY INS","E")=$G(BILLRETURN(399,IBIFNIENS,"PRIMARY INSURANCE CARRIER","E"))
S ^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"SECONDARY INS","E")=$G(BILLRETURN(399,IBIFNIENS,"SECONDARY INSURANCE CARRIER","E"))
;
Q
S PATPTR=$G(BILLRETURN(399,IBIFNIENS,"PATIENT NAME","I")) ;PAT PTR
S PATSSN=$P($G(^DPT(PATPTR,0)),U,9)
I $G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E"))="" S ^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E")=PATSSN
;
Q
;
;ASK FOR FIELD SORT ORDER. CALL FROM IBACCWLSORT
IBSORTOR(IBZ,IBSORT,IBSORTOR,LVL,VALMQUIT) ;GET SORT ORDER;TPF;IB*2*770v12;EBILL-4224
N DIR,DTOUT,DUOUT,DIROUT,FILTERSORTS,X,Y
;
;I IBZ="C" D Q ;CLAIM AMOUNT
I IBZ="A" D ;TPF;IB*2*770v20;EBILL-4968
. 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(DUOUT) S VALMQUIT=1 K @("IBSORT"_LVL) Q ;TPF;IB*2*770v27;EBILL-5297
. 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
.I Y S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
.E S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
;
;I IBZ="S" D Q ; SERVICE DATE question
I IBZ="S" D ;TPF;IB*2*770v18;EBILL-4623
. S DIR(0)="Y"
. S DIR("A")="Display Oldest Encounters 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 Encounters with old dates of service at the top of the list"
. S DIR("?",4)="and Encounters with recent dates of service at the bottom of the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to see Encounters with recent dates of service at the top of the list"
. S DIR("?")="and older Encounters at the bottom of the list."
. D ^DIR K DIR
. I $D(DTOUT) S VALMQUIT=1 Q ; timeout
. I $D(DUOUT) S VALMQUIT=1 K @("IBSORT"_LVL) Q ;TPF;IB*2*770v27;EBILL-5297
. 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
.I Y S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
.E S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
;
I IBZ="R" D Q ; STATUS question
. S DIR(0)="Y"
. S DIR("A")="Display Encounter 'In Progress' 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 Encounters 'In Progress' at the bottom of"
. S DIR("?",4)="the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to group together Encounters 'In Progress' at the top of the"
. S DIR("?")="list."
. D ^DIR K DIR
. I $D(DTOUT) S VALMQUIT=1 Q ; timeout
. I $D(DUOUT) S VALMQUIT=1 K @("IBSORT"_LVL) Q ;TPF;IB*2*770v27;EBILL-5297
. 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
.I Y S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
.E S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
;
I IBZ="SFN" D Q ;SERVICE FACILITY NPI ;TPF;IB*2*770v12;EBILL-4224
. S DIR(0)="Y"
. S DIR("A")="Display NPI is Descending order",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 larger NPIs 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 smaller NPIs 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(DUOUT) S VALMQUIT=1 K @("IBSORT"_LVL) Q ;TPF;IB*2*770v27;EBILL-5297
. 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
.I Y S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
.E S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
;
;BEGIN TPF;IB*2*770v38;EBILL-5505 ONLY RUR GETS PRIMARY DX AS A SORT
I IBZ="X" D
. S DIR(0)="Y"
. S DIR("A")="Display Primary DX in Ascending order"
. S 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 Primary DX alphanumerical ordered first to last."
. S DIR("?",4)=""
. S DIR("?",5)="No, I want to see the Primary DX in reverse alphanumerical order last at the top of the list."
. S DIR("?")=""
. D ^DIR K DIR
. I $D(DTOUT) S VALMQUIT=1 Q ; timeout
. I $D(DUOUT) S VALMQUIT=1 K @("IBSORT"_LVL) Q
. I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="A" ; yes, large first, ascending
. I 'Y S IBSORTOR(IBZ)="D" ; no, small first, descending
.I Y S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
.E S IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
;END TPF;IB*2*770v38;EBILL-5505
;
I $G(VALMQUIT) Q ;TPF;IB*2*770v27;EBILL-5297
;ADDTIONAL FILTERS TO SORTS
;TPF;IB*2*770v20;EBILL-4631;FOR SORT "FILTER"
;
;Q:(U_"FRT"_U_"PTF"_U_"IV"_U)'[(U_USERGROUP_U) ;TPF;IB*2*770v25;EBILL-4705 CANNOT FILTER OUT RUR AND IV ANYMORE
S FILTERSORTS="" ;AND FILTERSORTS FOR ALL GROUPS DEFAULTS TO NULL
;
;I USERGROUP="IV" S FILTERSORTS=U_"M"_U ;THESE ARE SORTS THAT HAVE BEEN REQUESTED TO HAVE "FILTERS" ADDED TO THEM PER EBILL-4631
I USERGROUP="FRT"!(USERGROUP="PTF") S FILTERSORTS=U_"A"_U_"E"_U_"N"_U_"M"_U_"P"_U_"L"_U
;
I USERGROUP="IV"!(USERGROUP="RUR")!(USERGROUP="BILL") S FILTERSORTS=U_"A"_U_"E"_U_"M"_U_"N"_U_"P"_U ;TPF;IB*2*770v27;EBILL-5355
;
I USERGROUP="RUR" S FILTERSORTS=FILTERSORTS_U_"X"_U ;TPF;IB*2*770v38;EBILL-5505 ONLY RUR GETS PRIMARY DX AS A SORT
;
S FILTERSORTS=FILTERSORTS_U_"S"_U ;TPF;IB*2*770v25;EBILL-4705 FOR ALL GROUPS ADD DATE OF SERVICE TO FILTER LIST
;
I FILTERSORTS[(U_IBZ_U) D
.N FILTER3649,FILTER399,FILE,FIELD ;TPF XINDEX
.S FIELD=$O(IBSORT(LVL,"364.9 FIELD NAME","")) ;CLUMSY
.S:FIELD'="" FILE=364.9
.;
.S IBSORTFIL(LVL,IBZ)=" "_$$SORTFILTER^IBACCWLUTIL2(FILE,FIELD)
;
;PRESENT THE LOGIC TO THE USER AND REMOVE LOGIC FROM THE ARRAY
;CJ DID NOT SEEM TO THINK THE USER COULD USE THIS. TOO MUCH INFO???
;W !!,"Below is the filter logic you have chosen for this worklist load."
N CODE,FIELD,LEVEL,LOGIC,SORTTYP
S LEVEL=0
F S LEVEL=$O(IBSORTFIL(LEVEL)) Q:'LEVEL D
.S SORTTYP=""
.F S SORTTYP=$O(IBSORTFIL(LEVEL,SORTTYP)) Q:SORTTYP="" D
..S FIELD=$O(IBSORT(LEVEL,""),-1)
..S CODE=$P(IBSORTFIL(LEVEL,SORTTYP),"|")
..S LOGIC=$P(IBSORTFIL(LEVEL,SORTTYP),"|",2)
..S $P(IBSORTFIL(LEVEL,SORTTYP),"|",2)=""
..S IBSORTFIL(LEVEL,SORTTYP)=$TR(IBSORTFIL(LEVEL,SORTTYP),"|")
..;W !!,$S(LOGIC'="":LOGIC,1:"No Filter selected for "_$G(FIELD)_".")
..S IBSORTFIL(LEVEL,SORTTYP,"LOGIC")=LOGIC
..I CODE=" " K IBSORTFIL(LEVEL,SORTTYP),IBSORTFIL(LEVEL,"LOGIC")
W !!
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLSORT1 13326 printed May 25, 2026@12:10:11 Page 2
IBACCWLSORT1 ;EDE/TPF - ACC (Automated Community Care) Encounters Sort Global Sets ; 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 BY THE eBIZ TEAM FOR THE ACC ENCOUNTERS
+4 QUIT
+5 ;
+6 ;CALLED FROM PULL3649^IBACCWL1
SORTSET(RETURN,ENCIENS,BILLRETURN,IBIFN,RETURNREC) ;EP - SORT THE FIELD DATA PULLED BY THE USER'S SORT AND FILTER SETTINGS
+1 ;IBSORT(1,"364.9 FIELD NAME","REASONS")=""
+2 ;IBSORT(1,"399 FIELD NAME","UNDEF")=""
+3 ;IBSORT(1,"Reason Not AutoBilled")=""
+4 ;IBSORT(2,"364.9 FIELD NAME","SERVICE DATE")=""
+5 ;IBSORT(2,"399 FIELD NAME","UNDEF")=""
+6 ;IBSORT(2,"Date of Service")=""
+7 ;IBSORT(2,"YES")="D"
+8 ;IBSORT(3,"364.9 FIELD NAME","DAYS ON WORKLIST")=""
+9 ;IBSORT(3,"399 FIELD NAME","UNDEF")=""
+10 ;IBSORT(3,"Days on the Worklist")=""
+11 ;
+12 ;IBSORT(1,"364.9 FIELD NAME","X12 CLAIM NUMBER")=""
+13 ;IBSORT(1,"399 FIELD NAME","BILL NUMBER")=""
+14 ;IBSORT(1,"Bill Number")=""
+15 ;IBSORTOR(1)="D"
+16 ;
+17 NEW FIELD3649,FIELD399,FLDORD,IBSORTED1,IBSORTED2,IBSORTED3,ORDER3649,ORDER399,PAIDAMT,PATNAME,PAYERPTR,VAR
+18 ;
+19 FOR FLDORD=1:1:3
SET VAR="IBSORTED"_FLDORD
SET @VAR@(FLDORD)="UNDEF"
+20 ;
+21 SET FLDORD=0
+22 FOR
SET FLDORD=$ORDER(IBSORT(FLDORD))
if 'FLDORD
QUIT
Begin DoDot:1
+23 SET FIELD3649=$ORDER(IBSORT(FLDORD,"364.9 FIELD NAME",""))
+24 SET FIELD399=$ORDER(IBSORT(FLDORD,"399 FIELD NAME",""))
+25 SET ORDER3649=$GET(IBSORT(FLDORD,FIELD3649))
+26 SET ORDER399=$GET(IBSORT(FLDORD,FIELD399))
+27 if FIELD3649=""
SET FIELD3649="UNDEF"
+28 if FIELD399=""
SET FIELD399="UNDEF"
+29 SET VAR="IBSORTED"_FLDORD
+30 ;
+31 ;TPF;IB*2*770v18;EBILL-4623
IF FIELD3649="PATIENT SSN"
Begin DoDot:2
+32 ;NO NEED TO SPACE PREFIX THE SORT ON FULL SSN
IF $PIECE(VALMDDF("SSN"),U,3)=9
Begin DoDot:3
+33 SET @VAR@(FLDORD)=$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"E"),"UNDEF")
End DoDot:3
+34 IF '$TEST
SET @VAR@(FLDORD)=" "_$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"E"))
+35 if @VAR@(FLDORD)=" "
SET @VAR@(FLDORD)=""
End DoDot:2
QUIT
+36 ;
+37 ;TPF;IB*2*770v17;EBILL-4736
IF FIELD3649="SERVICE DATE"
Begin DoDot:2
+38 ;TPF;IB*2*770v8;EBILL-4440
SET @VAR@(FLDORD)=$SELECT(ORDER3649="A":"-",1:"")_$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF")
End DoDot:2
QUIT
+39 ;
+40 ;TPF;IB*2*770v17;EBILL-4736
IF FIELD3649="DAYS ON GROUP WORKLIST"
Begin DoDot:2
+41 ;TPF;IB*2*770v8;EBILL-
SET @VAR@(FLDORD)=$SELECT(ORDER3649="D":"-",1:"")_$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"))
End DoDot:2
QUIT
+42 ;
+43 ;TPF;IB*2*770v8;EBILL-4224
IF FIELD3649="SERVICE FACILITY NPI"
Begin DoDot:2
+44 SET @VAR@(FLDORD)=$SELECT(ORDER3649="D":"-",1:"")_$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF")
End DoDot:2
QUIT
+45 ;
+46 IF FIELD3649="STATUS"
Begin DoDot:2
+47 ;WCJ
NEW S1
SET S1="IBACCUTIL"
+48 SET @VAR@(FLDORD)=$SELECT(ORDER3649="D"&$GET(^TMP(S1,$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"))=1:"00",ORDER3649="A"&$GET(^TMP(S1,$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"))=1:"-1",1:$GET(^TMP(S1,...
... $JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF"))
End DoDot:2
QUIT
+49 ;
+50 IF FIELD3649="PATIENT NAME"
Begin DoDot:2
+51 SET PATNAME=$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT LAST NAME","E"))_", "_$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT FIRST NAME","E"))_" "_...
... $GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT MIDDLE NAME","E"))
+52 SET @VAR@(FLDORD)=$GET(PATNAME)
End DoDot:2
QUIT
+53 ;
+54 IF FIELD3649="PAID AMOUNT"
Begin DoDot:2
+55 IF ORDER3649="D"
SET PAIDAMT=-$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PAID AMOUNT","E"))
+56 IF '$TEST
SET PAIDAMT=+$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PAID AMOUNT","E"))
+57 SET @VAR@(FLDORD)=$GET(PAIDAMT)
End DoDot:2
QUIT
+58 ;
+59 ;TPF;IB*2*770v25;BEGIN EBILL-5133
+60 IF FIELD3649="SITE NUMBER"
Begin DoDot:2
+61 NEW SITEIEN,SITENAME
+62 SET SITEIEN=$$LKUP^XUAF4($GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"E")))
+63 SET SITENAME=$PIECE($$NNT^XUAF4(SITEIEN),U)
+64 SET @VAR@(FLDORD)=SITENAME
End DoDot:2
QUIT
+65 ;TPF;IB*2*770v25;END EBILL-5133
+66 ;
+67 ;TPF;IB*2*770v38;EBILL-5505
IF FIELD3649="PRIMARY DX"
Begin DoDot:2
+68 IF ORDER3649="A"
Begin DoDot:3
+69 SET @VAR@(FLDORD)=$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF")
End DoDot:3
+70 IF '$TEST
Begin DoDot:3
+71 SET @VAR@(FLDORD)=$$INVERT^IBACCWLSORT1($GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"I"),"UNDEF"))
End DoDot:3
End DoDot:2
QUIT
+72 ;
+73 IF FIELD3649'=""
SET @VAR@(FLDORD)=$GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,FIELD3649,"E"))
+74 ;
+75 IF $GET(IBIFN)
DO BILL399OVER(RETURNREC)
+76 ;
+77 if $GET(FIELD399)="UNDEF"!('IBIFN)
QUIT
+78 ;
+79 ;IF 399 HAS A FIELD DEFINED ITS VALUE TAKES PRECEDENCE OVER A VALUE FOUND IN 364.9
+80 ;
+81 ;PAYER
IF FIELD399="$$CURR~IBCEF2(IBIFN)"
Begin DoDot:2
+82 SET PAYERPTR=$$CURR^IBCEF2(IBIFN)
+83 IF PAYERPTR
SET @VAR@(FLDORD)=$$GET1^DIQ(36,PAYERPTR_",",.01)
End DoDot:2
QUIT
+84 ;
+85 IF FIELD399="$$INPAT^IBCEF(IBIFN)"
Begin DoDot:2
+86 SET @VAR@(FLDORD)=$$INPAT^IBCEF(IBIFN)
End DoDot:2
QUIT
+87 ;
+88 IF FIELD399'=""
SET @VAR@(FLDORD)=$GET(BILLRETURN(399,IBIFN_",",FIELD399,"E"))
End DoDot:1
+89 ;
+90 ;IF NO DATA FOUND ;TPF;IB*2*770v11;EBIL-???? UNDEF SORT WRONG 'Z' DOES NOT DISPLAY
FOR FLDORD=1:1:3
SET VAR="IBSORTED"_FLDORD
IF @VAR@(FLDORD)=""
SET @VAR@(FLDORD)="z "
+91 ;
+92 IF $GET(IBIFN)
IF $$TRANSMITTED^IBACCWLUTIL1(IBIFN)
DO UPDSTATUS^IBACCWLUTIL(+ENCIENS,"CLOSED")
QUIT
+93 ;
+94 IF $GET(IBIFN)
MERGE ^TMP("IBACCUTIL",$JOB,"K# SORTED",IBSORTED1(1),IBSORTED2(2),IBSORTED3(3))=^TMP("IBACCUTIL",$JOB,RETURNREC)
+95 IF '$TEST
MERGE ^TMP("IBACCUTIL",$JOB,"NO K# SORTED",IBSORTED1(1),IBSORTED2(2),IBSORTED3(3))=^TMP("IBACCUTIL",$JOB,RETURNREC)
+96 ;
+97 QUIT
+98 ;
+99 ;S STR="TESTSTRING" W $$INVERT^IBACCWLSORT1(STR)
INVERT(STR) ;EP - INVERT STRING FOR REVERSE SORT - USED FOR DX
+1 NEW CHAR,RESULT
+2 SET RESULT=""
+3 FOR CHAR=1:1:$LENGTH(STR)
Begin DoDot:1
+4 SET RESULT=RESULT_$CHAR(255-$ASCII($EXTRACT(STR,CHAR)))
End DoDot:1
+5 QUIT RESULT
+6 ;
+7 ;THERE IS NOT ENOUGH DATA AT THIS TIME 5/8/2024 TO REALLY MAKE A GOOD DECISION ABOUT OVERWRITING ALL OF THESE FIELDS
BILL399OVER(RETURNREC) ;EP - 399 DATA OVERRIDES 364.9
+1 NEW IBIFNIENS,PATPTR,PATSSN,PRIMINS,SECINS
+2 ;
+3 SET IBIFNIENS=IBIFN_","
+4 SET ^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PRIMARY INS","E")=$GET(BILLRETURN(399,IBIFNIENS,"PRIMARY INSURANCE CARRIER","E"))
+5 SET ^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"SECONDARY INS","E")=$GET(BILLRETURN(399,IBIFNIENS,"SECONDARY INSURANCE CARRIER","E"))
+6 ;
+7 QUIT
+8 ;PAT PTR
SET PATPTR=$GET(BILLRETURN(399,IBIFNIENS,"PATIENT NAME","I"))
+9 SET PATSSN=$PIECE($GET(^DPT(PATPTR,0)),U,9)
+10 IF $GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E"))=""
SET ^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E")=PATSSN
+11 ;
+12 QUIT
+13 ;
+14 ;ASK FOR FIELD SORT ORDER. CALL FROM IBACCWLSORT
IBSORTOR(IBZ,IBSORT,IBSORTOR,LVL,VALMQUIT) ;GET SORT ORDER;TPF;IB*2*770v12;EBILL-4224
+1 NEW DIR,DTOUT,DUOUT,DIROUT,FILTERSORTS,X,Y
+2 ;
+3 ;I IBZ="C" D Q ;CLAIM AMOUNT
+4 ;TPF;IB*2*770v20;EBILL-4968
IF IBZ="A"
Begin DoDot:1
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Display Highest Balances First"
SET DIR("B")="Yes"
+7 SET DIR("A",1)=""
+8 SET DIR("?",1)="Enter Yes or No."
+9 SET DIR("?",2)=""
+10 SET DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
+11 SET DIR("?",4)="small balances last at the bottom of the list."
+12 SET DIR("?",5)=""
+13 SET DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
+14 SET DIR("?")="large balances last at the bottom of the list."
+15 DO ^DIR
KILL DIR
+16 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+17 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+18 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+19 ; yes, large first, descending
IF Y
SET IBSORTOR(IBZ)="D"
+20 ; no, small first, ascending
IF 'Y
SET IBSORTOR(IBZ)="A"
+21 IF Y
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
+22 IF '$TEST
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
End DoDot:1
+23 ;
+24 ;I IBZ="S" D Q ; SERVICE DATE question
+25 ;TPF;IB*2*770v18;EBILL-4623
IF IBZ="S"
Begin DoDot:1
+26 SET DIR(0)="Y"
+27 SET DIR("A")="Display Oldest Encounters First"
SET DIR("B")="Yes"
+28 SET DIR("A",1)=""
+29 SET DIR("?",1)="Enter Yes or No."
+30 SET DIR("?",2)=""
+31 SET DIR("?",3)="Yes, I want to see Encounters with old dates of service at the top of the list"
+32 SET DIR("?",4)="and Encounters with recent dates of service at the bottom of the list."
+33 SET DIR("?",5)=""
+34 SET DIR("?",6)="No, I want to see Encounters with recent dates of service at the top of the list"
+35 SET DIR("?")="and older Encounters at the bottom of the list."
+36 DO ^DIR
KILL DIR
+37 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+38 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+39 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+40 ; yes, old first, ascending sort
IF Y
SET IBSORTOR(IBZ)="A"
+41 ; no, new first, descending sort
IF 'Y
SET IBSORTOR(IBZ)="D"
+42 IF Y
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
+43 IF '$TEST
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
End DoDot:1
+44 ;
+45 ; STATUS question
IF IBZ="R"
Begin DoDot:1
+46 SET DIR(0)="Y"
+47 SET DIR("A")="Display Encounter 'In Progress' Last"
SET DIR("B")="Yes"
+48 SET DIR("A",1)=""
+49 SET DIR("?",1)="Enter Yes or No."
+50 SET DIR("?",2)=""
+51 SET DIR("?",3)="Yes, I want to group together Encounters 'In Progress' at the bottom of"
+52 SET DIR("?",4)="the list."
+53 SET DIR("?",5)=""
+54 SET DIR("?",6)="No, I want to group together Encounters 'In Progress' at the top of the"
+55 SET DIR("?")="list."
+56 DO ^DIR
KILL DIR
+57 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+58 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+59 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+60 ; yes, 1 at bottom, 0 at top, ascending
IF Y
SET IBSORTOR(IBZ)="A"
+61 ; no, 1 at top, 0 at bottom, descending
IF 'Y
SET IBSORTOR(IBZ)="D"
+62 IF Y
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
+63 IF '$TEST
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
End DoDot:1
QUIT
+64 ;
+65 ;SERVICE FACILITY NPI ;TPF;IB*2*770v12;EBILL-4224
IF IBZ="SFN"
Begin DoDot:1
+66 SET DIR(0)="Y"
+67 SET DIR("A")="Display NPI is Descending order"
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 the larger NPIs first at the top of the list and the"
+72 SET DIR("?",4)="small balances last at the bottom of the list."
+73 SET DIR("?",5)=""
+74 SET DIR("?",6)="No, I want to see the smaller NPIs first at the top of the list and the"
+75 SET DIR("?")="large balances last at the bottom of the list."
+76 DO ^DIR
KILL DIR
+77 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+78 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+79 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+80 ; yes, large first, descending
IF Y
SET IBSORTOR(IBZ)="D"
+81 ; no, small first, ascending
IF 'Y
SET IBSORTOR(IBZ)="A"
+82 IF Y
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
+83 IF '$TEST
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
End DoDot:1
QUIT
+84 ;
+85 ;BEGIN TPF;IB*2*770v38;EBILL-5505 ONLY RUR GETS PRIMARY DX AS A SORT
+86 IF IBZ="X"
Begin DoDot:1
+87 SET DIR(0)="Y"
+88 SET DIR("A")="Display Primary DX in Ascending order"
+89 SET DIR("B")="Yes"
+90 SET DIR("A",1)=""
+91 SET DIR("?",1)="Enter Yes or No."
+92 SET DIR("?",2)=""
+93 SET DIR("?",3)="Yes, I want to see the Primary DX alphanumerical ordered first to last."
+94 SET DIR("?",4)=""
+95 SET DIR("?",5)="No, I want to see the Primary DX in reverse alphanumerical order last at the top of the list."
+96 SET DIR("?")=""
+97 DO ^DIR
KILL DIR
+98 ; timeout
IF $DATA(DTOUT)
SET VALMQUIT=1
QUIT
+99 IF $DATA(DUOUT)
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+100 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET VALMQUIT=1
KILL @("IBSORT"_LVL)
QUIT
+101 ; yes, large first, ascending
IF Y
SET IBSORTOR(IBZ)="A"
+102 ; no, small first, descending
IF 'Y
SET IBSORTOR(IBZ)="D"
+103 IF Y
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="A"
+104 IF '$TEST
SET IBSORT(LVL,$$FLD3649^IBACCWLSORT(IBZ))="D"
End DoDot:1
+105 ;END TPF;IB*2*770v38;EBILL-5505
+106 ;
+107 ;TPF;IB*2*770v27;EBILL-5297
IF $GET(VALMQUIT)
QUIT
+108 ;ADDTIONAL FILTERS TO SORTS
+109 ;TPF;IB*2*770v20;EBILL-4631;FOR SORT "FILTER"
+110 ;
+111 ;Q:(U_"FRT"_U_"PTF"_U_"IV"_U)'[(U_USERGROUP_U) ;TPF;IB*2*770v25;EBILL-4705 CANNOT FILTER OUT RUR AND IV ANYMORE
+112 ;AND FILTERSORTS FOR ALL GROUPS DEFAULTS TO NULL
SET FILTERSORTS=""
+113 ;
+114 ;I USERGROUP="IV" S FILTERSORTS=U_"M"_U ;THESE ARE SORTS THAT HAVE BEEN REQUESTED TO HAVE "FILTERS" ADDED TO THEM PER EBILL-4631
+115 IF USERGROUP="FRT"!(USERGROUP="PTF")
SET FILTERSORTS=U_"A"_U_"E"_U_"N"_U_"M"_U_"P"_U_"L"_U
+116 ;
+117 ;TPF;IB*2*770v27;EBILL-5355
IF USERGROUP="IV"!(USERGROUP="RUR")!(USERGROUP="BILL")
SET FILTERSORTS=U_"A"_U_"E"_U_"M"_U_"N"_U_"P"_U
+118 ;
+119 ;TPF;IB*2*770v38;EBILL-5505 ONLY RUR GETS PRIMARY DX AS A SORT
IF USERGROUP="RUR"
SET FILTERSORTS=FILTERSORTS_U_"X"_U
+120 ;
+121 ;TPF;IB*2*770v25;EBILL-4705 FOR ALL GROUPS ADD DATE OF SERVICE TO FILTER LIST
SET FILTERSORTS=FILTERSORTS_U_"S"_U
+122 ;
+123 IF FILTERSORTS[(U_IBZ_U)
Begin DoDot:1
+124 ;TPF XINDEX
NEW FILTER3649,FILTER399,FILE,FIELD
+125 ;CLUMSY
SET FIELD=$ORDER(IBSORT(LVL,"364.9 FIELD NAME",""))
+126 if FIELD'=""
SET FILE=364.9
+127 ;
+128 SET IBSORTFIL(LVL,IBZ)=" "_$$SORTFILTER^IBACCWLUTIL2(FILE,FIELD)
End DoDot:1
+129 ;
+130 ;PRESENT THE LOGIC TO THE USER AND REMOVE LOGIC FROM THE ARRAY
+131 ;CJ DID NOT SEEM TO THINK THE USER COULD USE THIS. TOO MUCH INFO???
+132 ;W !!,"Below is the filter logic you have chosen for this worklist load."
+133 NEW CODE,FIELD,LEVEL,LOGIC,SORTTYP
+134 SET LEVEL=0
+135 FOR
SET LEVEL=$ORDER(IBSORTFIL(LEVEL))
if 'LEVEL
QUIT
Begin DoDot:1
+136 SET SORTTYP=""
+137 FOR
SET SORTTYP=$ORDER(IBSORTFIL(LEVEL,SORTTYP))
if SORTTYP=""
QUIT
Begin DoDot:2
+138 SET FIELD=$ORDER(IBSORT(LEVEL,""),-1)
+139 SET CODE=$PIECE(IBSORTFIL(LEVEL,SORTTYP),"|")
+140 SET LOGIC=$PIECE(IBSORTFIL(LEVEL,SORTTYP),"|",2)
+141 SET $PIECE(IBSORTFIL(LEVEL,SORTTYP),"|",2)=""
+142 SET IBSORTFIL(LEVEL,SORTTYP)=$TRANSLATE(IBSORTFIL(LEVEL,SORTTYP),"|")
+143 ;W !!,$S(LOGIC'="":LOGIC,1:"No Filter selected for "_$G(FIELD)_".")
+144 SET IBSORTFIL(LEVEL,SORTTYP,"LOGIC")=LOGIC
+145 IF CODE=" "
KILL IBSORTFIL(LEVEL,SORTTYP),IBSORTFIL(LEVEL,"LOGIC")
End DoDot:2
End DoDot:1
+146 WRITE !!
+147 ;
+148 QUIT
