IBACCWLUTIL5 ;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
;TPF;IB*2*770v44*EBILL-5941
PRIMDXTEXT(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,IBTARGET,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:Primary Dx Code Begins with;R:Primary Dx Code Range (Inclusive);C:Primary Dx Description Contains"
S DIR("B")="N"
D ^DIR
I X=U S VALMQUIT=1
;
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="N") S RETURNCODE="" Q
;
S TYPE=$P(Y,U)
;
I TYPE="R" S FIELD=".14" D DXSTRRANGE(FILE,FIELDNUM,FIELDNAME,.RETURNCODE) Q
;
W !
K DIR
I TYPE="B" D
.S DIR("A")="Include all Primary Dx beginning with"
.S DIR("?",1)="Enter a complete or partial Primary Dx to include all Primary Dx"
.S DIR("?",2)="that begin with your entry."
.S DIR("?",3)="For example, entering E11 would include Primary Dx such as"
.S DIR("?",4)="E11.00, E11.311 or E11.9"
.S DIR("?")=" "
;
I TYPE="C" D
.S DIR("A")="Include all Primary Dx whose description contains"
.S DIR("?")="For example, entering DIABETES or Diabetes would include all Primary DX that have that word in the ICD Description."
.S DIR("?",1)="E11.21 - Type 2 diabetes mellitus with diabetic nephropathy"
.S DIR("?",2)="E11.22 - Type 2 diabetes mellitus w diabetic chronic kidney disease"
.S DIR("?",3)="E11.622 - Type 2 diabetes mellitus with other skin ulcer"
.S DIR("?",4)="E11.65 - Type 2 diabetes mellitus with hyperglycemia"
.S DIR("?",5)="E11.69 - Type 2 diabetes mellitus with other specified complication"
.S DIR("?",6)="E11.9 - Type 2 diabetes mellitus without complications"
.S DIR("?",7)=" "
;
S DIR(0)="FO^1:20^K:'(X'?1P.E) X"
D ^DIR
I X=U S VALMQUIT=1
I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
;
S IBTARGET=$$UPPER^IBACCWLUTIL($P(Y,U))
S IBTARGET=$TR(IBTARGET,".")
S LENGTH=$L(IBTARGET)
;
I TYPE="B" S GETFIELDCODE="$E("_GETFIELDCODE_",1,"_LENGTH_")" S RETURNCODE="I "_GETFIELDCODE_"="""_IBTARGET_""""
;
I TYPE="C" D
.S RETURNCODE=" S IBTARGET="""_IBTARGET_""" I $$PRIMDXSCREEN^IBACCWLUTIL5(Y,IBTARGET)"
;
S LOGIC="For field "_$G(FIELDNAME)_", you entered a "_$G(FIELDNAME)_" or partial "_$G(FIELDNAME)_" value of "_$G(IBTARGET)_" to be included in your worklist."
S RETURNCODE=RETURNCODE_"|"_LOGIC
;
Q
;
ICDCODE(ICD) ;EP -RETURN CODE ONLY
Q $P($$ICDLKUP^IBACCWLVE1A(ICD)," -")
;
DXSTRRANGE(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 !,"separated by a '-' to filter by a range alphabetically."
W !!
;
REDOSR ;REDO RANGE FROM/TO ASK
;
S DIR(0)="FO^1:40^K:X'?.A.N1""-"".A.N X" ;K:'(X'?1P.E) X Q:'$D(X)
S DIR("?",1)="You may enter one or several characters"
S DIR("?",2)="separated by a '-'"
S DIR("?",3)=" "
S DIR("?",4)="For example:"
S DIR("?",5)="Enter E11-G to filter for Primary Dx between E11 and G."
S DIR("?",6)="Enter D-F to filter for Primary Dx between D and F."
S DIR("?",7)="All filters are inclusive."
S DIR("?")=" "
;
S DIR("A")=$$TITLE^XLFSTR(FIELDNAME)_" range"
D ^DIR
I X=U S VALMQUIT=1
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q
;
S Y=$$UPPER^IBACCWLUTIL(Y)
S Y=$TR(Y,".")
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(FROMVLAUE)_"' will be displayed."
.S RETURNCODE=RETURNCODE_"|"_LOGIC
;
Q
;
PRIMDXSCREEN(Y,IBTARGET) ;EP - LOAD SCREEN FOR PRIMARY DX
;
Q:'Y 0
N IBDESCIEN,IBENCIFN,IBPRIMDX
S IBENCIFN=$G(Y)
;
S IBPRIMDX=$$GET1^DIQ(364.9,IBENCIFN_",",.14,"E")
Q:IBPRIMDX="" 0
;
S IBPRIMDX=$$ICDCODE^IBACCWLUTIL5(IBPRIMDX)
Q:IBPRIMDX="" 0
;
S IBPRIMDX=$O(^ICD9("AB",IBPRIMDX_" ",""))
Q:IBPRIMDX="" 0
;
S IBDESCIEN=$O(^ICD9(IBPRIMDX,68,"B"),-1) ;GET LATEST DESCRIPTION
Q:IBDESCIEN="" 0
;
I $$UPPER^IBACCWLUTIL($$GET1^DIQ(80.068,IBDESCIEN_","_IBPRIMDX_",","DESCRIPTION","E"))[($G(IBTARGET)) Q 1
;
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLUTIL5 5473 printed May 25, 2026@12:10:18 Page 2
IBACCWLUTIL5 ;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 ;TPF;IB*2*770v44*EBILL-5941
PRIMDXTEXT(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,IBTARGET,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:Primary Dx Code Begins with;R:Primary Dx Code Range (Inclusive);C:Primary Dx Description Contains"
+13 SET DIR("B")="N"
+14 DO ^DIR
+15 IF X=U
SET VALMQUIT=1
+16 ;
+17 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="N")
SET RETURNCODE=""
QUIT
+18 ;
+19 SET TYPE=$PIECE(Y,U)
+20 ;
+21 IF TYPE="R"
SET FIELD=".14"
DO DXSTRRANGE(FILE,FIELDNUM,FIELDNAME,.RETURNCODE)
QUIT
+22 ;
+23 WRITE !
+24 KILL DIR
+25 IF TYPE="B"
Begin DoDot:1
+26 SET DIR("A")="Include all Primary Dx beginning with"
+27 SET DIR("?",1)="Enter a complete or partial Primary Dx to include all Primary Dx"
+28 SET DIR("?",2)="that begin with your entry."
+29 SET DIR("?",3)="For example, entering E11 would include Primary Dx such as"
+30 SET DIR("?",4)="E11.00, E11.311 or E11.9"
+31 SET DIR("?")=" "
End DoDot:1
+32 ;
+33 IF TYPE="C"
Begin DoDot:1
+34 SET DIR("A")="Include all Primary Dx whose description contains"
+35 SET DIR("?")="For example, entering DIABETES or Diabetes would include all Primary DX that have that word in the ICD Description."
+36 SET DIR("?",1)="E11.21 - Type 2 diabetes mellitus with diabetic nephropathy"
+37 SET DIR("?",2)="E11.22 - Type 2 diabetes mellitus w diabetic chronic kidney disease"
+38 SET DIR("?",3)="E11.622 - Type 2 diabetes mellitus with other skin ulcer"
+39 SET DIR("?",4)="E11.65 - Type 2 diabetes mellitus with hyperglycemia"
+40 SET DIR("?",5)="E11.69 - Type 2 diabetes mellitus with other specified complication"
+41 SET DIR("?",6)="E11.9 - Type 2 diabetes mellitus without complications"
+42 SET DIR("?",7)=" "
End DoDot:1
+43 ;
+44 SET DIR(0)="FO^1:20^K:'(X'?1P.E) X"
+45 DO ^DIR
+46 IF X=U
SET VALMQUIT=1
+47 IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+48 ;
+49 SET IBTARGET=$$UPPER^IBACCWLUTIL($PIECE(Y,U))
+50 SET IBTARGET=$TRANSLATE(IBTARGET,".")
+51 SET LENGTH=$LENGTH(IBTARGET)
+52 ;
+53 IF TYPE="B"
SET GETFIELDCODE="$E("_GETFIELDCODE_",1,"_LENGTH_")"
SET RETURNCODE="I "_GETFIELDCODE_"="""_IBTARGET_""""
+54 ;
+55 IF TYPE="C"
Begin DoDot:1
+56 SET RETURNCODE=" S IBTARGET="""_IBTARGET_""" I $$PRIMDXSCREEN^IBACCWLUTIL5(Y,IBTARGET)"
End DoDot:1
+57 ;
+58 SET LOGIC="For field "_$GET(FIELDNAME)_", you entered a "_$GET(FIELDNAME)_" or partial "_$GET(FIELDNAME)_" value of "_$GET(IBTARGET)_" to be included in your worklist."
+59 SET RETURNCODE=RETURNCODE_"|"_LOGIC
+60 ;
+61 QUIT
+62 ;
ICDCODE(ICD) ;EP -RETURN CODE ONLY
+1 QUIT $PIECE($$ICDLKUP^IBACCWLVE1A(ICD)," -")
+2 ;
DXSTRRANGE(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 !,"separated by a '-' to filter by a range alphabetically."
+10 WRITE !!
+11 ;
REDOSR ;REDO RANGE FROM/TO ASK
+1 ;
+2 ;K:'(X'?1P.E) X Q:'$D(X)
SET DIR(0)="FO^1:40^K:X'?.A.N1""-"".A.N X"
+3 SET DIR("?",1)="You may enter one or several characters"
+4 SET DIR("?",2)="separated by a '-'"
+5 SET DIR("?",3)=" "
+6 SET DIR("?",4)="For example:"
+7 SET DIR("?",5)="Enter E11-G to filter for Primary Dx between E11 and G."
+8 SET DIR("?",6)="Enter D-F to filter for Primary Dx between D and F."
+9 SET DIR("?",7)="All filters are inclusive."
+10 SET DIR("?")=" "
+11 ;
+12 SET DIR("A")=$$TITLE^XLFSTR(FIELDNAME)_" range"
+13 DO ^DIR
+14 IF X=U
SET VALMQUIT=1
+15 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT
+16 ;
+17 SET Y=$$UPPER^IBACCWLUTIL(Y)
+18 SET Y=$TRANSLATE(Y,".")
+19 IF Y[("-")
Begin DoDot:1
+20 SET FROMVALUE=$PIECE(Y,"-")
+21 SET TOVALUE=$PIECE(Y,"-",2)
+22 IF TOVALUE=FROMVALUE!(FROMVALUE]TOVALUE)
WRITE !!,"Please enter a valid range of alphanumeric strings."
GOTO REDOSR
+23 ;
+24 SET RETURNCODE="I "_GETFIELDCODE_"]"""_FROMVALUE_"""&("_GETFIELDCODE_"']"""_TOVALUE_""")!(($E("_GETFIELDCODE_",1,$L("""_$GET(FROMVALUE)_"""))="""_$GET(FROMVALUE)_""")!($E("_GETFIELDCODE_",1,$L("""_$GET(TOVALUE)_"""))="""_$GET(TOVALUE)_"
""))"
+25 SET LOGIC="For field "_$GET(FIELDNAME)_", the values that sort aplhabetically between '"_$GET(FROMVALUE)_"' and '"_$GET(TOVALUE)_"' will be displayed."
+26 SET RETURNCODE=RETURNCODE_"|"_LOGIC
End DoDot:1
QUIT
+27 IF '$TEST
Begin DoDot:1
+28 SET FROMVALUE=Y
+29 SET RETURNCODE="I $E("_GETFIELDCODE_",1,$L("""_$GET(FROMVALUE)_"""))="""_$GET(FROMVALUE)_""""
+30 SET LOGIC="For field "_$GET(FIELDNAME)_", the values that sort aplhabetically after '"_$GET(FROMVLAUE)_"' will be displayed."
+31 SET RETURNCODE=RETURNCODE_"|"_LOGIC
End DoDot:1
+32 ;
+33 QUIT
+34 ;
PRIMDXSCREEN(Y,IBTARGET) ;EP - LOAD SCREEN FOR PRIMARY DX
+1 ;
+2 if 'Y
QUIT 0
+3 NEW IBDESCIEN,IBENCIFN,IBPRIMDX
+4 SET IBENCIFN=$GET(Y)
+5 ;
+6 SET IBPRIMDX=$$GET1^DIQ(364.9,IBENCIFN_",",.14,"E")
+7 if IBPRIMDX=""
QUIT 0
+8 ;
+9 SET IBPRIMDX=$$ICDCODE^IBACCWLUTIL5(IBPRIMDX)
+10 if IBPRIMDX=""
QUIT 0
+11 ;
+12 SET IBPRIMDX=$ORDER(^ICD9("AB",IBPRIMDX_" ",""))
+13 if IBPRIMDX=""
QUIT 0
+14 ;
+15 ;GET LATEST DESCRIPTION
SET IBDESCIEN=$ORDER(^ICD9(IBPRIMDX,68,"B"),-1)
+16 if IBDESCIEN=""
QUIT 0
+17 ;
+18 IF $$UPPER^IBACCWLUTIL($$GET1^DIQ(80.068,IBDESCIEN_","_IBPRIMDX_",","DESCRIPTION","E"))[($GET(IBTARGET))
QUIT 1
+19 ;
+20 QUIT 0
