IBACCWLUTIL2 ;EDE/TPF - ACC (Automated Community Care) Encounters utility APIs (Cont.) ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;CALLED FROM PULLLIST^IBACCWL1
ADDFILTERS(SCREEN,IBSORTFIL) ;EP - ;ADD USER SCREENs TO BASIC SCREENS
;
;INPUT
;SCREEN = BASIC DIC("S") WORKLIST SCREEN
;I $P(^(0),U,16)'=2,($P(^(0),U,16)'=3) I $$DAYSSCREEN^IBACCWLUTIL(DT,$P(^(0),U),0)
;
;IBSORTFIL = SORT FILTERS ASKED FOR FILTERING EACH SORT USER WISHES TO SORT BY
;IBSORTFIL(1,"P")=" I $$GET1^DIQ(364.9,Y_"","",""PRIMARY INS"",""I"")=7170300"
;
;OUTPUT
;SCREEN UDATED TO INCLUDE THE BASIC SORTSCREEN PLUS ALL THE USER SORT FILTERS
;
;SORTTYP = MATCHES THE SORT MNEUMONIC THE USER CHOSE AT THE SORT PROMPTS, E.G. P=PAYER
;
N SORTTYP,LEVEL
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 SCREEN=SCREEN_IBSORTFIL(LEVEL,SORTTYP)
;
Q
;
;TPF;IB*2*770v18;EBILL-4631;FOR "FILTERS"
;CALLED BY IBSORTOR^IBACCWLSORT1
SORTFILTER(FILE,FIELDNAME) ;EP
;
N FIELDNUM,RETURNCODE,SORTTYPE,TAGCALL
;
I FIELDNAME="REASONS" D
.S FIELDNAME="REASONS NOT AUTOBILLED"
;
I FIELDNAME="PATIENT NAME" D
.S FIELDNAME="PATIENT LAST NAME"
;
S SORTTYPE=$TR($$GET1^DID(FILE,FIELDNAME,"","TYPE")," ")
;
;POINTER FOR FIELD #5 REASONS NOT AUTOBILLED, #.17 PRIMARY INSURANCE (PAYER)
;
I SORTTYPE="COMPUTED",(FIELD="DAYS ON GROUP WORKLIST") S SORTTYPE="NUMERIC"
;
;S FIELDNUM=$O(^DD(364.9,"B",FIELDNAME,""))
S FIELDNUM=$$FLDNUM^DILFD(364.9,FIELDNAME) ;MJL fix
;
;THIS SECTION FOR SPECIAL PROMPTS FOR NON STANDARD FIELD TYPE PROMPTS
I (FIELDNAME="PATIENT LAST NAME") S SORTTYPE="STRRANGE"
I FIELDNAME="PATIENT SSN" S SORTTYPE="LASTSSN"
;
I FIELDNAME="PRIMARY DX" S SORTTYPE="PRIMDX" ;TPF;IB*2*770v38;EBILL-5505 I AM SETTING UP A SPECIAL LOOKUP FOR DX AND BYPASSING THE GENERIC PTR TAG BECAUSE IT WAS GETTING MESSY AND NOT REALLY GENERIC
;
S (TAGCALL,SORTTYPE)=$TR(SORTTYPE," /")
S TAGCALL=SORTTYPE_"("""_FILE_""","""_FIELDNUM_""","""_FIELDNAME_""",.RETURNCODE)"
D @TAGCALL
;
Q RETURNCODE
;
STRRANGE(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - STRING RANGE - THIS IS THE FUNTIONALITY ASKED BY THE USER
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" S RETURNCODE="Invalid Parameters!" Q
;
N DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,FROMVALUE,LOGIC,TOVALUE
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""E"")"
;
W !!,"For field "_$G(FIELDNAME)_", you may enter one or several characters"
W !,"to filter by or a range separated by a '-' to filter by a range alphabetically."
W !!
;
REDOSR ;REDO RANGE FROM/TO ASK
;
S DIR(0)="FO^1:40^K:X'?.AP.1""-"".APA X"
S DIR("?",1)="You may enter one or several characters to search for"
S DIR("?",2)="or a range separated by a '-'"
S DIR("?",3)=" "
S DIR("?",4)="For example:"
S DIR("?",5)="Enter SMITH to filter for Patient Last Names beginning with SMITH."
S DIR("?",6)="Enter FR to filter for Patient Last Names beginning with FR."
S DIR("?",7)="or enter SMITH-SMOTH to filter for Patient Last Names"
S DIR("?")="beginning with SMITH and ending with SMOTHER, e.g. SMITH-SMOTHER"
;
S DIR("A")=$$TITLE^XLFSTR(FIELDNAME)_" begins with"
D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
;
I Y[("-") D Q
.S FROMVALUE=$P(Y,"-")
.S TOVALUE=$P(Y,"-",2)
.I TOVALUE=FROMVALUE!(FROMVALUE]TOVALUE) W !!,"Please enter a valid range of alphanumeric strings." G REDOSR
.;
.S RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUE_"""&("_GETFIELDCODE_"']"""_TOVALUE_""")!(($E("_GETFIELDCODE_",1,$L("""_$G(FROMVALUE)_"""))="""_$G(FROMVALUE)_""")!($E("_GETFIELDCODE_",1,$L("""_$G(TOVALUE)_"""))="""_$G(TOVALUE)_"""))"
.S LOGIC="For field "_$G(FIELDNAME)_", the values that sort aplhabetically between '"_$G(FROMVALUE)_"' and '"_$G(TOVALUE)_"' will be displayed."
.S RETURNCODE=RETURNCODE_"|"_LOGIC
E D
.S FROMVALUE=Y
.S RETURNCODE="I $E("_GETFIELDCODE_",1,$L("""_$G(FROMVALUE)_"""))="""_$G(FROMVALUE)_""""
.S LOGIC="For field "_$G(FIELDNAME)_", the values that sort aplhabetically after '"_$G(FROMVALUE)_"' will be displayed."
.S RETURNCODE=RETURNCODE_"|"_LOGIC
;
Q
;
;D NUMERIC^IBACCWLUTIL2(364.9,.27,"AMOUNT PAID",.RETURN)
NUMERIC(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO NUMERIC SUBSORT PROMPTS
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" S RETURNCODE="Invalid Parameters!" Q
;
N DIR,DIROUT,DUOUT,DTOUT,FROM,TO
;
I FIELDNAME="PAID AMOUNT" S FIELDNAME=$$TITLE^XLFSTR("AMOUNT PAID")
;
S DIR("A")="Choose "_$G(FIELDNAME)_" filter type"
S DIR("?")="Enter a filter type to perform."
S DIR("??")="Enter the filter type you wish to perform on the data."
S DIR(0)="SO^N:No Filter;=:Equal to;>:Greater than;<:Less than;>=:Greater than or Equal to;<=:Less than or equal to;R:Range"
S DIR("B")="N"
D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
;
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="N") S RETURNCODE="" Q
;
I Y=">" S RETURNCODE=$$GREATERTHAN^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME) Q
I Y=">=" S RETURNCODE=$$GREATTHANEQUALTO^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME) Q
I Y="<" S RETURNCODE=$$LESSTHAN^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME) Q
I Y="<=" S RETURNCODE=$$LESSTHANEQUALTO^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME) Q
I Y="=" S RETURNCODE=$$EQUALTO^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME) Q
;
S RETURNCODE=$$NUMRANGE^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
;
Q
;
POINTER(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP ; POINTER NEEDS A LOOKUP TO ALLOW
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" S RETURNCODE="Invalid Parameters!" Q
;
N X,Y
N DIR,DUOUT,DIROUT,DTOUT,ERRORDESC,FROMVALUENAME,GETFIELDCODE,LOGIC,PTRFILE,PTRFILE,ROOT,VALUE,VALUENAME,X,Y ;TPF XINDEX
N TOVALUE,TOVALUENAME,SUBILE ;TPF XINDEX
;
I FIELDNAME="REASONS NOT AUTOBILLED" D
.S FIELDNAME="REASON NOT AUTOBILLED"
.S PTRFILE=364.91
.S SUBFILE=364.95 ;ONLY DIFFERENT THAN FILE IF POINTER IS A MULTIPLE
.S DIR("A")="Display encounters that contain error code" ;EBILL-5846;v39
.S DIR("?")="Enter the Error Code or partial error code description to display"
.;
.W !!,"For Error Code Text, enter the numeric Error Code or partial Error Code" ;TPF;IB*2*770v25;EBILL-5033
.W !,"Description you wish to include in your worklist. All encounters displayed" ;TPF;IB*2*770v25;EBILL-5033
.W !,"will contain the error code selected, even if additional error codes" ;EBILL-5846;v39
.W !,"are present. You may need to expand the entry to see all codes." ;EBILL-5846;v39
;
I FIELDNAME="PRIMARY INS" D
.S PTRFILE=36
.S SUBFILE=364.9
.S DIR("A")="Enter the Payer FROM Filter"
.S DIR("?")="Enter the Payer FROM Filter"
.W !!,"For field "_$G(FIELDNAME)_", enter the first Payer you wish to include in your worklist alphabetically."
;
S GETFIELDCODE="$$GET1^DIQ("_SUBFILE_",Y_"","","""_FIELDNAME_""",""E"")"
;
W !
S ROOT=$$ROOT^DILFD(PTRFILE)
S DIR(0)="PO"_ROOT_":QEM"
D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
;
S FROMVALUE=$P(Y,U)
S FROMVALUENAME=$P(Y,U,2)
I FIELDNAME="REASON NOT AUTOBILLED" D
.S FROMVALUENAME=$$GET1^DIQ(PTRFILE,+Y_",",.02,"E")
;
I FIELDNAME="PRIMARY INS" D
.W !!,"For field "_$G(FIELDNAME)_", enter the last Payer you wish to include in your worklist." ;TPF;IB*2*770v36;EBILL-5775
.S ROOT=$$ROOT^DILFD(PTRFILE)
.S DIR("A")="Enter the Payer TO Filter"
.S DIR("?")="Enter the Payer TO Filter"
.S DIR(0)="PO"_ROOT_":QEM"
.D ^DIR
.I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
.I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
.S TOVALUE=$P(Y,U)
.S TOVALUENAME=$P(Y,U,2)
;
;LOOK FOR ENTRIES FOLLOWING FROMVALUE
I FIELDNAME="REASON NOT AUTOBILLED" D
.S ERRORDESC=$$GET1^DIQ(364.91,+Y_",","DESCRIPTION","E")
.S RETURNCODE="I $$ERRORCODE^IBACCWLUTIL2(Y,"""_ERRORDESC_""")"
;
E I FROMVALUE,($G(TOVALUE)="") S RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUENAME_"""!("_GETFIELDCODE_"="""_FROMVALUENAME_""")"
;
;LOOK FOR ALL ENTRIES THAT EQUAL FROMVALUE
I FROMVALUE=$G(TOVALUE) S RETURNCODE="I "_GETFIELDCODE_"="""_FROMVALUENAME_""""
;
;LOOK FOR ENTRIES THAT FOLLOW FROMVALUE AND DO NOT FOLLOW TOVALUE
I FROMVALUE,$G(TOVALUE),(FROMVALUE'=$G(TOVALUE)) D
.S FROMVALUENAME=FROMVALUENAME
.S TOVALUENAME=TOVALUENAME
.S RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUENAME_"""&("_GETFIELDCODE_"']"""_TOVALUENAME_""")!("_GETFIELDCODE_"="""_FROMVALUENAME_""")"
;
I FIELDNAME="PRIMARY INS" D
.S LOGIC="For field "_$G(FIELDNAME)_", you entered the Payer "_$G(FROMVALUENAME)_" to include in your worklist."
;
I FIELDNAME="REASON NOT AUTOBILLED" D
.S LOGIC="For field "_$G(FIELDNAME)_", you entered the Reason not Autobilled Code "_$G(FROMVALUENAME)_" to include in your worklist."
;
S RETURNCODE=RETURNCODE_"|"_LOGIC
;
Q
;
ERRORCODE(IBENCIFN,ERRORDESC) ;EP - LOOK FOR ERRO CODE
;
N FOUND,REASDESC,REASIEN,REASIENS,REASPTR ;TPF XINDEX
;
S FOUND=0
S REASIEN=0
F S REASIEN=$O(^IBA(364.9,IBENCIFN,5,REASIEN)) Q:'REASIEN!(FOUND) D
.S REASIENS=REASIEN_","_IBENCIFN_","
.S REASPTR=$$GET1^DIQ(364.95,REASIENS,.01,"I")
.S REASDESC=$$GET1^DIQ(364.91,REASPTR_",",.02,"E")
.I REASDESC[ERRORDESC S FOUND=1
;
Q FOUND
;
;K RETURNCODE D DATETIME^IBACCWLUTIL2(364.9,.12,"SERVICE DATE",.RETURNCODE)
;TPF;IB*2*770v25;BEGIN EBILL-4705
DATETIME(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO DATE FILTER PROMPTS
;
N DIR,DIROUT,DUOUT,DTOUT,GETFIELDCODE,FROMDT,NEWLASTDAY,TODT,TYPE
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""I"")"
;
W !
ASKFRDT ;ASK STARTING DATE AGAIN
K DIR,DIROUT,DUOUT,DTOUT
S DIR(0)="DO"
S DIR("A")="Include Service Dates from this date"
I '$D(FROMDT) S DIR("B")=$$FMTE^XLFDT(DT,"2ZD")
E S DIR("B")=$$FMTE^XLFDT(FROMDT,"2ZD")
S DIR("?",1)="If you do not wish to enter a Service Date filter enter ^ to exit."
S DIR("?",2)=" "
S DIR("?",3)="Examples of Valid Dates:"
S DIR("?",4)=" JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057 (omitting punctuation)"
S DIR("?",5)=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc."
S DIR("?",6)=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
S DIR("?",7)="If the year is omitted, the computer uses CURRENT YEAR."
S DIR("?")="A 2-digit year means no more than 20 years in the future, or 80 years in the past."
D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
S FROMDT=Y
I $E(FROMDT,6,7)="00" S $E(FROMDT,6,7)="01"
W " "_$$FMTE^XLFDT($G(FROMDT),"2ZD")
;
;ASK ENDING DATE
K DIR,DIROUT,DUOUT,DTOUT
S DIR(0)="DO"
S DIR("A")="and up to this Service Date date"
;
S TODT=FROMDT
I $E(FROMDT,6,7)="01" D
.S $E(TODT,6,7)=$$DOM^IBACCWLUTIL3(TODT)
;
S DIR("B")=$$FMTE^XLFDT(TODT,"2ZD")
S DIR("?",1)="If you do not wish to enter a ending Service Date enter ^ to return to the previous prompt."
S DIR("?",2)=" "
S DIR("?",3)="Examples of Valid Dates:"
S DIR("?",4)=" JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057 (omitting punctuation)"
S DIR("?",5)=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc."
S DIR("?",6)=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
S DIR("?",7)="If the year is omitted, the computer uses CURRENT YEAR."
S DIR("?")="A 2-digit year means no more than 20 years in the future, or 80 years in the past."
D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="") G ASKFRDT
S TODT=Y
;
I $E(TODT,6,7)="00" S $E(TODT,6,7)=$$DOM^IBACCWLUTIL3(TODT)
W " "_$$FMTE^XLFDT($G(TODT),"2ZD")
;
I FROMDT>TODT D G ASKFRDT
.W !!,"You have entered an invalid date range."
.W !,"The start date should be ealier than the end date."
.W !
.N DIR,DIROUT,DUOUT,DTOUT
.S DIR(0)="EO"
.D ^DIR
;
S RETURNCODE="I "_GETFIELDCODE_">="_FROMDT_",("_GETFIELDCODE_"<="_TODT_")"
;
S RETURNCODE=RETURNCODE ;_"|"_$G(LOGIC)
;
Q
;TPF;IB*2*770v25;END EBILL-4705
;
;D LASTSSN^IBACCWLUTIL2(364.9,.29,"PATIENT LAST NAME",.RETURN)
LASTSSN(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO ALPHA FILTER PROMPTS
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" S RETURNCODE="Invalid Parameters!" Q
;
N DIR,DIROUT,DUOUT,DTOUT,GETFIELDCODE,LOGIC,TYPE,VALUE,X,Y,SSNTEXT
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""E"")"
;
S SSNTEXT=$S(SESSIONKEY="IBACCPTF":", enter the full SSN",1:", enter the last four digits of the SSN") ;MJL;IB*2*802v1;EBILL-5932
W !!,"For field "_$G(FIELDNAME)_SSNTEXT
W !,"you wish to include in your worklist."
;
ASKSSN ;EP ASK SSN AGAIN
;
W !
N DIR
I SESSIONKEY="IBACCPTF" D ;MJL;IB*2*802v1;EBILL-5932
. S DIR("A")="Enter the full SSN or 'N' for no filter"
. S DIE("?")="Enter the full SSN or 'N' for no filter"
. S DIR("B")="N"
. S DIR(0)="FO^1:9"
. D ^DIR
I SESSIONKEY'="IBACCPTF" D ;MJL;IB*2*802v1;EBILL-5932
. S DIR("A")="Enter last four SSN or 'N' for no filter"
. S DIE("?")="Enter last four SSN or 'N' for no filter"
. S DIR("B")="N"
. S DIR(0)="FO^1:4"
. D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="N") S RETURNCODE="" Q
;
I SESSIONKEY="IBACCPTF",X'?9N W !!,"SSN must be nine numerals!" G ASKSSN
I SESSIONKEY'="IBACCPTF",X'?4N W !!,"Last 4 SSN must be four numerals!" G ASKSSN
;
S VALUE=$P(Y,U)
;
I VALUE="" S RETURNCODE="" Q
;
S GETFIELDCODE="$E("_GETFIELDCODE_",$L("_GETFIELDCODE_")-$L("""_VALUE_""")+1,$L("_GETFIELDCODE_"))"
S RETURNCODE="I "_GETFIELDCODE_"="""_VALUE_""""
;
S:SESSIONKEY'="IBACCPTF" LOGIC="For field "_$G(FIELDNAME)_", you entered the last four SSN of "_$G(VALUE)_" to be included on your worklist."
S:SESSIONKEY="IBACCPTF" LOGIC="For field "_$G(FIELDNAME)_", you entered the SSN of "_$G(VALUE)_" to be included on your worklist."
S RETURNCODE=RETURNCODE_"|"_LOGIC
;
Q
;
;THIS IS A MORE POWERFULL LOOKUP THAN TAG STRANGE BUT NOT WHAT THE USER ASKED FOR
;FREE TEXT TYPE FIELDS WILL DEFAULT TO THIS UNLESS OTHERWISE DIVERTED IN TAG SORTFILTER
;D FREETEXT^IBACCWLUTIL2(364.9,.29,"PATIENT LAST NAME",.RETURN)
FREETEXT(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO ALPHA FILTER PROMPTS
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" S RETURNCODE="Invalid Parameters!" Q
;
N DIR,DIROUT,DUOUT,DTOUT,GETFIELDCODE,LENGTH,LOGIC,TARGET,TYPE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""E"")"
;
W !!,"For field "_$G(FIELDNAME)_", enter a "_$G(FIELDNAME)_" or partial "_$G(FIELDNAME)
W !,"you wish to include in your worklist."
;
S DIR("A")="Choose a filter type"
S DIR(0)="SO^N:No Filter;B:Begins with;E:Ends with;C:Contains"
S DIR("B")="N"
D ^DIR
I X=U S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="N") S RETURNCODE="" Q
;
S TYPE=$P(Y,U)
;
K DIR
S DIR("A")="Choose filter value"
S DIR("?")="Enter a value to filter."
S DIR(0)="FO^1:20"
D ^DIR
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
;
S TARGET=$P(Y,U)
S LENGTH=$L(TARGET)
;
I TYPE="B" S GETFIELDCODE="$E("_GETFIELDCODE_",1,"_LENGTH_")" S RETURNCODE="I "_GETFIELDCODE_"="""_TARGET_"""" Q
I TYPE="E" D Q
.S GETFIELDCODE="$E("_GETFIELDCODE_",$L("_GETFIELDCODE_")-$L("""_TARGET_""")+1,$L("_GETFIELDCODE_"))"
.S RETURNCODE="I "_GETFIELDCODE_"="""_TARGET_""""
;
I TYPE="C" D
.S RETURNCODE="I "_GETFIELDCODE_"["""_TARGET_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", you entered a "_$G(FIELDNAME)_" or partial "_$G(FIELDNAME)_" value of "_$G(TARGET)_" to be included in your worklist."
S RETURNCODE=RETURNCODE_"|"_LOGIC
;
Q
;
PRIMDX(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - PROMPT FOR PRIM DX FILTERS ;TPF;IB*2*770v44;EBILL-5505,EBILL-5941
;
D PRIMDXTEXT^IBACCWLUTIL5(FILE,FIELDNUM,FIELDNAME,.RETURNCODE) ;TPF;IB*2*770v44*EBILL-5941
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLUTIL2 16095 printed May 25, 2026@12:10:15 Page 2
IBACCWLUTIL2 ;EDE/TPF - ACC (Automated Community Care) Encounters utility APIs (Cont.) ; 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 ;
+4 QUIT
+5 ;
+6 ;CALLED FROM PULLLIST^IBACCWL1
ADDFILTERS(SCREEN,IBSORTFIL) ;EP - ;ADD USER SCREENs TO BASIC SCREENS
+1 ;
+2 ;INPUT
+3 ;SCREEN = BASIC DIC("S") WORKLIST SCREEN
+4 ;I $P(^(0),U,16)'=2,($P(^(0),U,16)'=3) I $$DAYSSCREEN^IBACCWLUTIL(DT,$P(^(0),U),0)
+5 ;
+6 ;IBSORTFIL = SORT FILTERS ASKED FOR FILTERING EACH SORT USER WISHES TO SORT BY
+7 ;IBSORTFIL(1,"P")=" I $$GET1^DIQ(364.9,Y_"","",""PRIMARY INS"",""I"")=7170300"
+8 ;
+9 ;OUTPUT
+10 ;SCREEN UDATED TO INCLUDE THE BASIC SORTSCREEN PLUS ALL THE USER SORT FILTERS
+11 ;
+12 ;SORTTYP = MATCHES THE SORT MNEUMONIC THE USER CHOSE AT THE SORT PROMPTS, E.G. P=PAYER
+13 ;
+14 NEW SORTTYP,LEVEL
+15 SET LEVEL=0
+16 FOR
SET LEVEL=$ORDER(IBSORTFIL(LEVEL))
if 'LEVEL
QUIT
Begin DoDot:1
+17 SET SORTTYP=""
+18 FOR
SET SORTTYP=$ORDER(IBSORTFIL(LEVEL,SORTTYP))
if SORTTYP=""
QUIT
Begin DoDot:2
+19 SET SCREEN=SCREEN_IBSORTFIL(LEVEL,SORTTYP)
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
+22 ;
+23 ;TPF;IB*2*770v18;EBILL-4631;FOR "FILTERS"
+24 ;CALLED BY IBSORTOR^IBACCWLSORT1
SORTFILTER(FILE,FIELDNAME) ;EP
+1 ;
+2 NEW FIELDNUM,RETURNCODE,SORTTYPE,TAGCALL
+3 ;
+4 IF FIELDNAME="REASONS"
Begin DoDot:1
+5 SET FIELDNAME="REASONS NOT AUTOBILLED"
End DoDot:1
+6 ;
+7 IF FIELDNAME="PATIENT NAME"
Begin DoDot:1
+8 SET FIELDNAME="PATIENT LAST NAME"
End DoDot:1
+9 ;
+10 SET SORTTYPE=$TRANSLATE($$GET1^DID(FILE,FIELDNAME,"","TYPE")," ")
+11 ;
+12 ;POINTER FOR FIELD #5 REASONS NOT AUTOBILLED, #.17 PRIMARY INSURANCE (PAYER)
+13 ;
+14 IF SORTTYPE="COMPUTED"
IF (FIELD="DAYS ON GROUP WORKLIST")
SET SORTTYPE="NUMERIC"
+15 ;
+16 ;S FIELDNUM=$O(^DD(364.9,"B",FIELDNAME,""))
+17 ;MJL fix
SET FIELDNUM=$$FLDNUM^DILFD(364.9,FIELDNAME)
+18 ;
+19 ;THIS SECTION FOR SPECIAL PROMPTS FOR NON STANDARD FIELD TYPE PROMPTS
+20 IF (FIELDNAME="PATIENT LAST NAME")
SET SORTTYPE="STRRANGE"
+21 IF FIELDNAME="PATIENT SSN"
SET SORTTYPE="LASTSSN"
+22 ;
+23 ;TPF;IB*2*770v38;EBILL-5505 I AM SETTING UP A SPECIAL LOOKUP FOR DX AND BYPASSING THE GENERIC PTR TAG BECAUSE IT WAS GETTING MESSY AND NOT REALLY GENERIC
IF FIELDNAME="PRIMARY DX"
SET SORTTYPE="PRIMDX"
+24 ;
+25 SET (TAGCALL,SORTTYPE)=$TRANSLATE(SORTTYPE," /")
+26 SET TAGCALL=SORTTYPE_"("""_FILE_""","""_FIELDNUM_""","""_FIELDNAME_""",.RETURNCODE)"
+27 DO @TAGCALL
+28 ;
+29 QUIT RETURNCODE
+30 ;
STRRANGE(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - STRING RANGE - THIS IS THE FUNTIONALITY ASKED BY THE USER
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
SET RETURNCODE="Invalid Parameters!"
QUIT
+3 ;
+4 NEW DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,FROMVALUE,LOGIC,TOVALUE
+5 ;
+6 SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", you may enter one or several characters"
+9 WRITE !,"to filter by or a range separated by a '-' to filter by a range alphabetically."
+10 WRITE !!
+11 ;
REDOSR ;REDO RANGE FROM/TO ASK
+1 ;
+2 SET DIR(0)="FO^1:40^K:X'?.AP.1""-"".APA X"
+3 SET DIR("?",1)="You may enter one or several characters to search for"
+4 SET DIR("?",2)="or a range separated by a '-'"
+5 SET DIR("?",3)=" "
+6 SET DIR("?",4)="For example:"
+7 SET DIR("?",5)="Enter SMITH to filter for Patient Last Names beginning with SMITH."
+8 SET DIR("?",6)="Enter FR to filter for Patient Last Names beginning with FR."
+9 SET DIR("?",7)="or enter SMITH-SMOTH to filter for Patient Last Names"
+10 SET DIR("?")="beginning with SMITH and ending with SMOTHER, e.g. SMITH-SMOTHER"
+11 ;
+12 SET DIR("A")=$$TITLE^XLFSTR(FIELDNAME)_" begins with"
+13 DO ^DIR
+14 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+15 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+16 ;
+17 IF Y[("-")
Begin DoDot:1
+18 SET FROMVALUE=$PIECE(Y,"-")
+19 SET TOVALUE=$PIECE(Y,"-",2)
+20 IF TOVALUE=FROMVALUE!(FROMVALUE]TOVALUE)
WRITE !!,"Please enter a valid range of alphanumeric strings."
GOTO REDOSR
+21 ;
+22 SET RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUE_"""&("_GETFIELDCODE_"']"""_TOVALUE_""")!(($E("_GETFIELDCODE_",1,$L("""_$GET(FROMVALUE)_"""))="""_$GET(FROMVALUE)_""")!($E("_GETFIELDCODE_",1,$L("""_$GET(TOVALUE)_"""))="""_$GET(TOVALUE)_"
""))"
+23 SET LOGIC="For field "_$GET(FIELDNAME)_", the values that sort aplhabetically between '"_$GET(FROMVALUE)_"' and '"_$GET(TOVALUE)_"' will be displayed."
+24 SET RETURNCODE=RETURNCODE_"|"_LOGIC
End DoDot:1
QUIT
+25 IF '$TEST
Begin DoDot:1
+26 SET FROMVALUE=Y
+27 SET RETURNCODE="I $E("_GETFIELDCODE_",1,$L("""_$GET(FROMVALUE)_"""))="""_$GET(FROMVALUE)_""""
+28 SET LOGIC="For field "_$GET(FIELDNAME)_", the values that sort aplhabetically after '"_$GET(FROMVALUE)_"' will be displayed."
+29 SET RETURNCODE=RETURNCODE_"|"_LOGIC
End DoDot:1
+30 ;
+31 QUIT
+32 ;
+33 ;D NUMERIC^IBACCWLUTIL2(364.9,.27,"AMOUNT PAID",.RETURN)
NUMERIC(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO NUMERIC SUBSORT PROMPTS
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
SET RETURNCODE="Invalid Parameters!"
QUIT
+3 ;
+4 NEW DIR,DIROUT,DUOUT,DTOUT,FROM,TO
+5 ;
+6 IF FIELDNAME="PAID AMOUNT"
SET FIELDNAME=$$TITLE^XLFSTR("AMOUNT PAID")
+7 ;
+8 SET DIR("A")="Choose "_$GET(FIELDNAME)_" filter type"
+9 SET DIR("?")="Enter a filter type to perform."
+10 SET DIR("??")="Enter the filter type you wish to perform on the data."
+11 SET DIR(0)="SO^N:No Filter;=:Equal to;>:Greater than;<:Less than;>=:Greater than or Equal to;<=:Less than or equal to;R:Range"
+12 SET DIR("B")="N"
+13 DO ^DIR
+14 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+15 ;
+16 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="N")
SET RETURNCODE=""
QUIT
+17 ;
+18 IF Y=">"
SET RETURNCODE=$$GREATERTHAN^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
QUIT
+19 IF Y=">="
SET RETURNCODE=$$GREATTHANEQUALTO^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
QUIT
+20 IF Y="<"
SET RETURNCODE=$$LESSTHAN^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
QUIT
+21 IF Y="<="
SET RETURNCODE=$$LESSTHANEQUALTO^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
QUIT
+22 IF Y="="
SET RETURNCODE=$$EQUALTO^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
QUIT
+23 ;
+24 SET RETURNCODE=$$NUMRANGE^IBACCWLUTIL3(FILE,FIELDNUM,FIELDNAME)
+25 ;
+26 QUIT
+27 ;
POINTER(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP ; POINTER NEEDS A LOOKUP TO ALLOW
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
SET RETURNCODE="Invalid Parameters!"
QUIT
+3 ;
+4 NEW X,Y
+5 ;TPF XINDEX
NEW DIR,DUOUT,DIROUT,DTOUT,ERRORDESC,FROMVALUENAME,GETFIELDCODE,LOGIC,PTRFILE,PTRFILE,ROOT,VALUE,VALUENAME,X,Y
+6 ;TPF XINDEX
NEW TOVALUE,TOVALUENAME,SUBILE
+7 ;
+8 IF FIELDNAME="REASONS NOT AUTOBILLED"
Begin DoDot:1
+9 SET FIELDNAME="REASON NOT AUTOBILLED"
+10 SET PTRFILE=364.91
+11 ;ONLY DIFFERENT THAN FILE IF POINTER IS A MULTIPLE
SET SUBFILE=364.95
+12 ;EBILL-5846;v39
SET DIR("A")="Display encounters that contain error code"
+13 SET DIR("?")="Enter the Error Code or partial error code description to display"
+14 ;
+15 ;TPF;IB*2*770v25;EBILL-5033
WRITE !!,"For Error Code Text, enter the numeric Error Code or partial Error Code"
+16 ;TPF;IB*2*770v25;EBILL-5033
WRITE !,"Description you wish to include in your worklist. All encounters displayed"
+17 ;EBILL-5846;v39
WRITE !,"will contain the error code selected, even if additional error codes"
+18 ;EBILL-5846;v39
WRITE !,"are present. You may need to expand the entry to see all codes."
End DoDot:1
+19 ;
+20 IF FIELDNAME="PRIMARY INS"
Begin DoDot:1
+21 SET PTRFILE=36
+22 SET SUBFILE=364.9
+23 SET DIR("A")="Enter the Payer FROM Filter"
+24 SET DIR("?")="Enter the Payer FROM Filter"
+25 WRITE !!,"For field "_$GET(FIELDNAME)_", enter the first Payer you wish to include in your worklist alphabetically."
End DoDot:1
+26 ;
+27 SET GETFIELDCODE="$$GET1^DIQ("_SUBFILE_",Y_"","","""_FIELDNAME_""",""E"")"
+28 ;
+29 WRITE !
+30 SET ROOT=$$ROOT^DILFD(PTRFILE)
+31 SET DIR(0)="PO"_ROOT_":QEM"
+32 DO ^DIR
+33 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+34 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+35 ;
+36 SET FROMVALUE=$PIECE(Y,U)
+37 SET FROMVALUENAME=$PIECE(Y,U,2)
+38 IF FIELDNAME="REASON NOT AUTOBILLED"
Begin DoDot:1
+39 SET FROMVALUENAME=$$GET1^DIQ(PTRFILE,+Y_",",.02,"E")
End DoDot:1
+40 ;
+41 IF FIELDNAME="PRIMARY INS"
Begin DoDot:1
+42 ;TPF;IB*2*770v36;EBILL-5775
WRITE !!,"For field "_$GET(FIELDNAME)_", enter the last Payer you wish to include in your worklist."
+43 SET ROOT=$$ROOT^DILFD(PTRFILE)
+44 SET DIR("A")="Enter the Payer TO Filter"
+45 SET DIR("?")="Enter the Payer TO Filter"
+46 SET DIR(0)="PO"_ROOT_":QEM"
+47 DO ^DIR
+48 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+49 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+50 SET TOVALUE=$PIECE(Y,U)
+51 SET TOVALUENAME=$PIECE(Y,U,2)
End DoDot:1
+52 ;
+53 ;LOOK FOR ENTRIES FOLLOWING FROMVALUE
+54 IF FIELDNAME="REASON NOT AUTOBILLED"
Begin DoDot:1
+55 SET ERRORDESC=$$GET1^DIQ(364.91,+Y_",","DESCRIPTION","E")
+56 SET RETURNCODE="I $$ERRORCODE^IBACCWLUTIL2(Y,"""_ERRORDESC_""")"
End DoDot:1
+57 ;
+58 IF '$TEST
IF FROMVALUE
IF ($GET(TOVALUE)="")
SET RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUENAME_"""!("_GETFIELDCODE_"="""_FROMVALUENAME_""")"
+59 ;
+60 ;LOOK FOR ALL ENTRIES THAT EQUAL FROMVALUE
+61 IF FROMVALUE=$GET(TOVALUE)
SET RETURNCODE="I "_GETFIELDCODE_"="""_FROMVALUENAME_""""
+62 ;
+63 ;LOOK FOR ENTRIES THAT FOLLOW FROMVALUE AND DO NOT FOLLOW TOVALUE
+64 IF FROMVALUE
IF $GET(TOVALUE)
IF (FROMVALUE'=$GET(TOVALUE))
Begin DoDot:1
+65 SET FROMVALUENAME=FROMVALUENAME
+66 SET TOVALUENAME=TOVALUENAME
+67 SET RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUENAME_"""&("_GETFIELDCODE_"']"""_TOVALUENAME_""")!("_GETFIELDCODE_"="""_FROMVALUENAME_""")"
End DoDot:1
+68 ;
+69 IF FIELDNAME="PRIMARY INS"
Begin DoDot:1
+70 SET LOGIC="For field "_$GET(FIELDNAME)_", you entered the Payer "_$GET(FROMVALUENAME)_" to include in your worklist."
End DoDot:1
+71 ;
+72 IF FIELDNAME="REASON NOT AUTOBILLED"
Begin DoDot:1
+73 SET LOGIC="For field "_$GET(FIELDNAME)_", you entered the Reason not Autobilled Code "_$GET(FROMVALUENAME)_" to include in your worklist."
End DoDot:1
+74 ;
+75 SET RETURNCODE=RETURNCODE_"|"_LOGIC
+76 ;
+77 QUIT
+78 ;
ERRORCODE(IBENCIFN,ERRORDESC) ;EP - LOOK FOR ERRO CODE
+1 ;
+2 ;TPF XINDEX
NEW FOUND,REASDESC,REASIEN,REASIENS,REASPTR
+3 ;
+4 SET FOUND=0
+5 SET REASIEN=0
+6 FOR
SET REASIEN=$ORDER(^IBA(364.9,IBENCIFN,5,REASIEN))
if 'REASIEN!(FOUND)
QUIT
Begin DoDot:1
+7 SET REASIENS=REASIEN_","_IBENCIFN_","
+8 SET REASPTR=$$GET1^DIQ(364.95,REASIENS,.01,"I")
+9 SET REASDESC=$$GET1^DIQ(364.91,REASPTR_",",.02,"E")
+10 IF REASDESC[ERRORDESC
SET FOUND=1
End DoDot:1
+11 ;
+12 QUIT FOUND
+13 ;
+14 ;K RETURNCODE D DATETIME^IBACCWLUTIL2(364.9,.12,"SERVICE DATE",.RETURNCODE)
+15 ;TPF;IB*2*770v25;BEGIN EBILL-4705
DATETIME(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO DATE FILTER PROMPTS
+1 ;
+2 NEW DIR,DIROUT,DUOUT,DTOUT,GETFIELDCODE,FROMDT,NEWLASTDAY,TODT,TYPE
+3 ;
+4 SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""I"")"
+5 ;
+6 WRITE !
ASKFRDT ;ASK STARTING DATE AGAIN
+1 KILL DIR,DIROUT,DUOUT,DTOUT
+2 SET DIR(0)="DO"
+3 SET DIR("A")="Include Service Dates from this date"
+4 IF '$DATA(FROMDT)
SET DIR("B")=$$FMTE^XLFDT(DT,"2ZD")
+5 IF '$TEST
SET DIR("B")=$$FMTE^XLFDT(FROMDT,"2ZD")
+6 SET DIR("?",1)="If you do not wish to enter a Service Date filter enter ^ to exit."
+7 SET DIR("?",2)=" "
+8 SET DIR("?",3)="Examples of Valid Dates:"
+9 SET DIR("?",4)=" JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057 (omitting punctuation)"
+10 SET DIR("?",5)=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc."
+11 SET DIR("?",6)=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
+12 SET DIR("?",7)="If the year is omitted, the computer uses CURRENT YEAR."
+13 SET DIR("?")="A 2-digit year means no more than 20 years in the future, or 80 years in the past."
+14 DO ^DIR
+15 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+16 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+17 SET FROMDT=Y
+18 IF $EXTRACT(FROMDT,6,7)="00"
SET $EXTRACT(FROMDT,6,7)="01"
+19 WRITE " "_$$FMTE^XLFDT($GET(FROMDT),"2ZD")
+20 ;
+21 ;ASK ENDING DATE
+22 KILL DIR,DIROUT,DUOUT,DTOUT
+23 SET DIR(0)="DO"
+24 SET DIR("A")="and up to this Service Date date"
+25 ;
+26 SET TODT=FROMDT
+27 IF $EXTRACT(FROMDT,6,7)="01"
Begin DoDot:1
+28 SET $EXTRACT(TODT,6,7)=$$DOM^IBACCWLUTIL3(TODT)
End DoDot:1
+29 ;
+30 SET DIR("B")=$$FMTE^XLFDT(TODT,"2ZD")
+31 SET DIR("?",1)="If you do not wish to enter a ending Service Date enter ^ to return to the previous prompt."
+32 SET DIR("?",2)=" "
+33 SET DIR("?",3)="Examples of Valid Dates:"
+34 SET DIR("?",4)=" JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057 (omitting punctuation)"
+35 SET DIR("?",5)=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc."
+36 SET DIR("?",6)=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
+37 SET DIR("?",7)="If the year is omitted, the computer uses CURRENT YEAR."
+38 SET DIR("?")="A 2-digit year means no more than 20 years in the future, or 80 years in the past."
+39 DO ^DIR
+40 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+41 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="")
GOTO ASKFRDT
+42 SET TODT=Y
+43 ;
+44 IF $EXTRACT(TODT,6,7)="00"
SET $EXTRACT(TODT,6,7)=$$DOM^IBACCWLUTIL3(TODT)
+45 WRITE " "_$$FMTE^XLFDT($GET(TODT),"2ZD")
+46 ;
+47 IF FROMDT>TODT
Begin DoDot:1
+48 WRITE !!,"You have entered an invalid date range."
+49 WRITE !,"The start date should be ealier than the end date."
+50 WRITE !
+51 NEW DIR,DIROUT,DUOUT,DTOUT
+52 SET DIR(0)="EO"
+53 DO ^DIR
End DoDot:1
GOTO ASKFRDT
+54 ;
+55 SET RETURNCODE="I "_GETFIELDCODE_">="_FROMDT_",("_GETFIELDCODE_"<="_TODT_")"
+56 ;
+57 ;_"|"_$G(LOGIC)
SET RETURNCODE=RETURNCODE
+58 ;
+59 QUIT
+60 ;TPF;IB*2*770v25;END EBILL-4705
+61 ;
+62 ;D LASTSSN^IBACCWLUTIL2(364.9,.29,"PATIENT LAST NAME",.RETURN)
LASTSSN(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO ALPHA FILTER PROMPTS
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
SET RETURNCODE="Invalid Parameters!"
QUIT
+3 ;
+4 NEW DIR,DIROUT,DUOUT,DTOUT,GETFIELDCODE,LOGIC,TYPE,VALUE,X,Y,SSNTEXT
+5 ;
+6 SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""E"")"
+7 ;
+8 ;MJL;IB*2*802v1;EBILL-5932
SET SSNTEXT=$SELECT(SESSIONKEY="IBACCPTF":", enter the full SSN",1:", enter the last four digits of the SSN")
+9 WRITE !!,"For field "_$GET(FIELDNAME)_SSNTEXT
+10 WRITE !,"you wish to include in your worklist."
+11 ;
ASKSSN ;EP ASK SSN AGAIN
+1 ;
+2 WRITE !
+3 NEW DIR
+4 ;MJL;IB*2*802v1;EBILL-5932
IF SESSIONKEY="IBACCPTF"
Begin DoDot:1
+5 SET DIR("A")="Enter the full SSN or 'N' for no filter"
+6 SET DIE("?")="Enter the full SSN or 'N' for no filter"
+7 SET DIR("B")="N"
+8 SET DIR(0)="FO^1:9"
+9 DO ^DIR
End DoDot:1
+10 ;MJL;IB*2*802v1;EBILL-5932
IF SESSIONKEY'="IBACCPTF"
Begin DoDot:1
+11 SET DIR("A")="Enter last four SSN or 'N' for no filter"
+12 SET DIE("?")="Enter last four SSN or 'N' for no filter"
+13 SET DIR("B")="N"
+14 SET DIR(0)="FO^1:4"
+15 DO ^DIR
End DoDot:1
+16 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+17 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="N")
SET RETURNCODE=""
QUIT
+18 ;
+19 IF SESSIONKEY="IBACCPTF"
IF X'?9N
WRITE !!,"SSN must be nine numerals!"
GOTO ASKSSN
+20 IF SESSIONKEY'="IBACCPTF"
IF X'?4N
WRITE !!,"Last 4 SSN must be four numerals!"
GOTO ASKSSN
+21 ;
+22 SET VALUE=$PIECE(Y,U)
+23 ;
+24 IF VALUE=""
SET RETURNCODE=""
QUIT
+25 ;
+26 SET GETFIELDCODE="$E("_GETFIELDCODE_",$L("_GETFIELDCODE_")-$L("""_VALUE_""")+1,$L("_GETFIELDCODE_"))"
+27 SET RETURNCODE="I "_GETFIELDCODE_"="""_VALUE_""""
+28 ;
+29 if SESSIONKEY'="IBACCPTF"
SET LOGIC="For field "_$GET(FIELDNAME)_", you entered the last four SSN of "_$GET(VALUE)_" to be included on your worklist."
+30 if SESSIONKEY="IBACCPTF"
SET LOGIC="For field "_$GET(FIELDNAME)_", you entered the SSN of "_$GET(VALUE)_" to be included on your worklist."
+31 SET RETURNCODE=RETURNCODE_"|"_LOGIC
+32 ;
+33 QUIT
+34 ;
+35 ;THIS IS A MORE POWERFULL LOOKUP THAN TAG STRANGE BUT NOT WHAT THE USER ASKED FOR
+36 ;FREE TEXT TYPE FIELDS WILL DEFAULT TO THIS UNLESS OTHERWISE DIVERTED IN TAG SORTFILTER
+37 ;D FREETEXT^IBACCWLUTIL2(364.9,.29,"PATIENT LAST NAME",.RETURN)
FREETEXT(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - DO ALPHA FILTER PROMPTS
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
SET RETURNCODE="Invalid Parameters!"
QUIT
+3 ;
+4 NEW DIR,DIROUT,DUOUT,DTOUT,GETFIELDCODE,LENGTH,LOGIC,TARGET,TYPE,X,Y
+5 ;
+6 SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_FIELDNAME_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", enter a "_$GET(FIELDNAME)_" or partial "_$GET(FIELDNAME)
+9 WRITE !,"you wish to include in your worklist."
+10 ;
+11 SET DIR("A")="Choose a filter type"
+12 SET DIR(0)="SO^N:No Filter;B:Begins with;E:Ends with;C:Contains"
+13 SET DIR("B")="N"
+14 DO ^DIR
+15 ;TPF;IB*2*770v27;EBILL-5297
IF X=U
SET VALMQUIT=1
+16 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="N")
SET RETURNCODE=""
QUIT
+17 ;
+18 SET TYPE=$PIECE(Y,U)
+19 ;
+20 KILL DIR
+21 SET DIR("A")="Choose filter value"
+22 SET DIR("?")="Enter a value to filter."
+23 SET DIR(0)="FO^1:20"
+24 DO ^DIR
+25 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+26 ;
+27 SET TARGET=$PIECE(Y,U)
+28 SET LENGTH=$LENGTH(TARGET)
+29 ;
+30 IF TYPE="B"
SET GETFIELDCODE="$E("_GETFIELDCODE_",1,"_LENGTH_")"
SET RETURNCODE="I "_GETFIELDCODE_"="""_TARGET_""""
QUIT
+31 IF TYPE="E"
Begin DoDot:1
+32 SET GETFIELDCODE="$E("_GETFIELDCODE_",$L("_GETFIELDCODE_")-$L("""_TARGET_""")+1,$L("_GETFIELDCODE_"))"
+33 SET RETURNCODE="I "_GETFIELDCODE_"="""_TARGET_""""
End DoDot:1
QUIT
+34 ;
+35 IF TYPE="C"
Begin DoDot:1
+36 SET RETURNCODE="I "_GETFIELDCODE_"["""_TARGET_""""
End DoDot:1
+37 ;
+38 SET LOGIC="For field "_$GET(FIELDNAME)_", you entered a "_$GET(FIELDNAME)_" or partial "_$GET(FIELDNAME)_" value of "_$GET(TARGET)_" to be included in your worklist."
+39 SET RETURNCODE=RETURNCODE_"|"_LOGIC
+40 ;
+41 QUIT
+42 ;
PRIMDX(FILE,FIELDNUM,FIELDNAME,RETURNCODE) ;EP - PROMPT FOR PRIM DX FILTERS ;TPF;IB*2*770v44;EBILL-5505,EBILL-5941
+1 ;
+2 ;TPF;IB*2*770v44*EBILL-5941
DO PRIMDXTEXT^IBACCWLUTIL5(FILE,FIELDNUM,FIELDNAME,.RETURNCODE)
+3 ;
+4 QUIT
