IBCEDS1 ;ALB/ESG - EDI CLAIM STATUS REPORT - SELECTION CONT ;13-DEC-2007
;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
SORTSEL(LVL) ; sort selection criteria
; LVL - sort level 1, 2, or 3
;
NEW DIR,X,Y,LVLD,G,LN,S,SC,SCP,DTOUT,DUOUT,DIRUT,DIROUT,IBZ
K IBSORT3 I LVL<3 K IBSORT2 I LVL=1 K IBSORT1
I '$F(".1.2.3.","."_$G(LVL)_".") G SORTSELX
I STOP G SORTSELX
;
I LVL>1,$G(IBSORT1)="" D SORTSEL(1) I $G(IBSORT1)="" G SORTSELX
I LVL=3,$G(IBSORT2)="" D SORTSEL(2) I $G(IBSORT2)="" G SORTSELX
;
S LVLD=$S(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
;
S DIR("A")=LVLD_" Sort"
I LVL=1 S DIR("B")=$$SD("1")
I LVL>1 K DIR("B")
;
S DIR("?")="Enter a code from the list to indicate the "_LVLD_" sort order."
I LVL>1 S DIR("?",1)=" Primary Sort is "_$$SD($G(IBSORT1)),DIR("?",LVL)=""
I LVL=3 S DIR("?",2)="Secondary Sort is "_$$SD($G(IBSORT2))
;
I LVL=1 S DIR(0)="SB" ; primary sort required
I LVL>1 S DIR(0)="SOB" ; optional sorts
;
S G=""
F LN=1:1 S S=$P($T(ZZ+LN),";",3) Q:S="" D
. S SC=$P(S,":",1) ; sort code
. I LVL=2,IBSORT1=SC Q
. I LVL=3,IBSORT1=SC!(IBSORT2=SC) Q
. S SCP=$P(S,":",1,2) ; sort code:desc pair
. S G=$S(G="":SCP,1:G_";"_SCP)
. Q
;
S $P(DIR(0),U,2)=G
;
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S STOP=1 G SORTSELX ; timeout or up arrow
I Y="" G SORTSELX ; null response
S @("IBSORT"_LVL)=Y,IBZ=Y
;
I IBZ="4" D G SORTSELX ; current balance question
. S DIR(0)="Y"
. S DIR("A")="Display Highest Balances First",DIR("B")="Yes"
. S DIR("A",1)=""
. S DIR("?",1)="Enter Yes or No."
. S DIR("?",2)=""
. S DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
. S DIR("?",4)="small balances last at the bottom of the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
. S DIR("?")="large balances last at the bottom of the list."
. D ^DIR K DIR
. I $D(DTOUT) S STOP=1 Q ; timeout
. I $D(DIRUT) S:LVL=1 STOP=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="D" ; yes, large first, descending
. I 'Y S IBSORTOR(IBZ)="A" ; no, small first, ascending
. Q
;
I IBZ="1" D G SORTSELX ; Last Transmitted Date Question
. S DIR(0)="Y"
. S DIR("A")="Display Oldest EDI Claims First",DIR("B")="Yes"
. S DIR("A",1)=""
. S DIR("?",1)="Enter Yes to display claims with oldest transmission dates first."
. S DIR("?")="Enter No to display claims with recent transmission dates first."
. D ^DIR K DIR
. I $D(DTOUT) S STOP=1 Q ; timeout
. I $D(DIRUT) S:LVL=1 STOP=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="A" ; yes, old first, ascending sort
. I 'Y S IBSORTOR(IBZ)="D" ; no, new first, descending sort
. Q
;
I IBZ="8" D G SORTSELX ; Age Question
. S DIR(0)="Y"
. S DIR("A")="Display Oldest EDI Claims First",DIR("B")="Yes"
. S DIR("A",1)=""
. S DIR("?",1)="Enter Yes or No."
. S DIR("?",2)=""
. S DIR("?",3)="Yes, I want to see old EDI claims first at the top of the list and newer"
. S DIR("?",4)="EDI claims last at the bottom of the list."
. S DIR("?",5)=""
. S DIR("?",6)="No, I want to see new EDI claims first at the top of the list and older"
. S DIR("?",7)="EDI claims last at the bottom of the list."
. S DIR("?",8)=""
. S DIR("?",9)="Note:"
. S DIR("?",10)="For MRA request claims, AGE is calculated as the number of days from the MRA"
. S DIR("?",11)="request date through today's date."
. S DIR("?",12)=""
. S DIR("?",13)="For all other claims, AGE is calculated as the number of days from the"
. S DIR("?")="Authorization date through today's date."
. D ^DIR K DIR
. I $D(DTOUT) S STOP=1 Q ; timeout
. I $D(DIRUT) S:LVL=1 STOP=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
. I Y S IBSORTOR(IBZ)="D" ; yes, old first, high age#'s first, descending
. I 'Y S IBSORTOR(IBZ)="A" ; no, new first, low age#'s first, ascending
. Q
;
SORTSELX ;
Q
;
SD(SORT) ; sort description given the sort code
Q $P($P($T(@("ZZ"_$G(SORT))),";",3),":",2)
;
SV(SORT,DEF) ; sort value given the sort code
; SORT - sort code
; DEF - default value if the sort code is nil (must be non-nil)
;
NEW S,VAR,VALUE
I $G(SORT)="" S VALUE=DEF G SVX
S S=$P($T(@("ZZ"_$G(SORT))),";",3)
S VAR=$P(S,":",4) ; variable name
S VALUE=$G(@VAR) ; value of variable
I VALUE="" S VALUE="~" G SVX ; get out if undefined
I '$P(S,":",3) G SVX ; non-numeric
I $G(IBSORTOR(SORT))="D" S VALUE=-VALUE ; descending sort
SVX Q VALUE
;
;
ZZ ; List of allowable sort criteria
ZZ1 ;;1:Last Transmitted Date:1:IBLTRDT;
ZZ2 ;;2:Payer:0:IBPAY;
ZZ3 ;;3:EDI Claim Status:0:IBEDIST;
ZZ4 ;;4:Current Balance:1:IBCURBAL;
ZZ5 ;;5:Division:0:IBDIV;
ZZ6 ;;6:Claim Number:0:IBEXTCLM;
ZZ7 ;;7:AR Status:0:IBARSTAT;
ZZ8 ;;8:Age:1:IBAGE;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEDS1 5016 printed Nov 22, 2024@17:20 Page 2
IBCEDS1 ;ALB/ESG - EDI CLAIM STATUS REPORT - SELECTION CONT ;13-DEC-2007
+1 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
SORTSEL(LVL) ; sort selection criteria
+1 ; LVL - sort level 1, 2, or 3
+2 ;
+3 NEW DIR,X,Y,LVLD,G,LN,S,SC,SCP,DTOUT,DUOUT,DIRUT,DIROUT,IBZ
+4 KILL IBSORT3
IF LVL<3
KILL IBSORT2
IF LVL=1
KILL IBSORT1
+5 IF '$FIND(".1.2.3.","."_$GET(LVL)_".")
GOTO SORTSELX
+6 IF STOP
GOTO SORTSELX
+7 ;
+8 IF LVL>1
IF $GET(IBSORT1)=""
DO SORTSEL(1)
IF $GET(IBSORT1)=""
GOTO SORTSELX
+9 IF LVL=3
IF $GET(IBSORT2)=""
DO SORTSEL(2)
IF $GET(IBSORT2)=""
GOTO SORTSELX
+10 ;
+11 SET LVLD=$SELECT(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
+12 ;
+13 SET DIR("A")=LVLD_" Sort"
+14 IF LVL=1
SET DIR("B")=$$SD("1")
+15 IF LVL>1
KILL DIR("B")
+16 ;
+17 SET DIR("?")="Enter a code from the list to indicate the "_LVLD_" sort order."
+18 IF LVL>1
SET DIR("?",1)=" Primary Sort is "_$$SD($GET(IBSORT1))
SET DIR("?",LVL)=""
+19 IF LVL=3
SET DIR("?",2)="Secondary Sort is "_$$SD($GET(IBSORT2))
+20 ;
+21 ; primary sort required
IF LVL=1
SET DIR(0)="SB"
+22 ; optional sorts
IF LVL>1
SET DIR(0)="SOB"
+23 ;
+24 SET G=""
+25 FOR LN=1:1
SET S=$PIECE($TEXT(ZZ+LN),";",3)
if S=""
QUIT
Begin DoDot:1
+26 ; sort code
SET SC=$PIECE(S,":",1)
+27 IF LVL=2
IF IBSORT1=SC
QUIT
+28 IF LVL=3
IF IBSORT1=SC!(IBSORT2=SC)
QUIT
+29 ; sort code:desc pair
SET SCP=$PIECE(S,":",1,2)
+30 SET G=$SELECT(G="":SCP,1:G_";"_SCP)
+31 QUIT
End DoDot:1
+32 ;
+33 SET $PIECE(DIR(0),U,2)=G
+34 ;
+35 DO ^DIR
KILL DIR
+36 ; timeout or up arrow
IF $DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SORTSELX
+37 ; null response
IF Y=""
GOTO SORTSELX
+38 SET @("IBSORT"_LVL)=Y
SET IBZ=Y
+39 ;
+40 ; current balance question
IF IBZ="4"
Begin DoDot:1
+41 SET DIR(0)="Y"
+42 SET DIR("A")="Display Highest Balances First"
SET DIR("B")="Yes"
+43 SET DIR("A",1)=""
+44 SET DIR("?",1)="Enter Yes or No."
+45 SET DIR("?",2)=""
+46 SET DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
+47 SET DIR("?",4)="small balances last at the bottom of the list."
+48 SET DIR("?",5)=""
+49 SET DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
+50 SET DIR("?")="large balances last at the bottom of the list."
+51 DO ^DIR
KILL DIR
+52 ; timeout
IF $DATA(DTOUT)
SET STOP=1
QUIT
+53 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET STOP=1
KILL @("IBSORT"_LVL)
QUIT
+54 ; yes, large first, descending
IF Y
SET IBSORTOR(IBZ)="D"
+55 ; no, small first, ascending
IF 'Y
SET IBSORTOR(IBZ)="A"
+56 QUIT
End DoDot:1
GOTO SORTSELX
+57 ;
+58 ; Last Transmitted Date Question
IF IBZ="1"
Begin DoDot:1
+59 SET DIR(0)="Y"
+60 SET DIR("A")="Display Oldest EDI Claims First"
SET DIR("B")="Yes"
+61 SET DIR("A",1)=""
+62 SET DIR("?",1)="Enter Yes to display claims with oldest transmission dates first."
+63 SET DIR("?")="Enter No to display claims with recent transmission dates first."
+64 DO ^DIR
KILL DIR
+65 ; timeout
IF $DATA(DTOUT)
SET STOP=1
QUIT
+66 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET STOP=1
KILL @("IBSORT"_LVL)
QUIT
+67 ; yes, old first, ascending sort
IF Y
SET IBSORTOR(IBZ)="A"
+68 ; no, new first, descending sort
IF 'Y
SET IBSORTOR(IBZ)="D"
+69 QUIT
End DoDot:1
GOTO SORTSELX
+70 ;
+71 ; Age Question
IF IBZ="8"
Begin DoDot:1
+72 SET DIR(0)="Y"
+73 SET DIR("A")="Display Oldest EDI Claims First"
SET DIR("B")="Yes"
+74 SET DIR("A",1)=""
+75 SET DIR("?",1)="Enter Yes or No."
+76 SET DIR("?",2)=""
+77 SET DIR("?",3)="Yes, I want to see old EDI claims first at the top of the list and newer"
+78 SET DIR("?",4)="EDI claims last at the bottom of the list."
+79 SET DIR("?",5)=""
+80 SET DIR("?",6)="No, I want to see new EDI claims first at the top of the list and older"
+81 SET DIR("?",7)="EDI claims last at the bottom of the list."
+82 SET DIR("?",8)=""
+83 SET DIR("?",9)="Note:"
+84 SET DIR("?",10)="For MRA request claims, AGE is calculated as the number of days from the MRA"
+85 SET DIR("?",11)="request date through today's date."
+86 SET DIR("?",12)=""
+87 SET DIR("?",13)="For all other claims, AGE is calculated as the number of days from the"
+88 SET DIR("?")="Authorization date through today's date."
+89 DO ^DIR
KILL DIR
+90 ; timeout
IF $DATA(DTOUT)
SET STOP=1
QUIT
+91 ; ^ or nil resp
IF $DATA(DIRUT)
if LVL=1
SET STOP=1
KILL @("IBSORT"_LVL)
QUIT
+92 ; yes, old first, high age#'s first, descending
IF Y
SET IBSORTOR(IBZ)="D"
+93 ; no, new first, low age#'s first, ascending
IF 'Y
SET IBSORTOR(IBZ)="A"
+94 QUIT
End DoDot:1
GOTO SORTSELX
+95 ;
SORTSELX ;
+1 QUIT
+2 ;
SD(SORT) ; sort description given the sort code
+1 QUIT $PIECE($PIECE($TEXT(@("ZZ"_$GET(SORT))),";",3),":",2)
+2 ;
SV(SORT,DEF) ; sort value given the sort code
+1 ; SORT - sort code
+2 ; DEF - default value if the sort code is nil (must be non-nil)
+3 ;
+4 NEW S,VAR,VALUE
+5 IF $GET(SORT)=""
SET VALUE=DEF
GOTO SVX
+6 SET S=$PIECE($TEXT(@("ZZ"_$GET(SORT))),";",3)
+7 ; variable name
SET VAR=$PIECE(S,":",4)
+8 ; value of variable
SET VALUE=$GET(@VAR)
+9 ; get out if undefined
IF VALUE=""
SET VALUE="~"
GOTO SVX
+10 ; non-numeric
IF '$PIECE(S,":",3)
GOTO SVX
+11 ; descending sort
IF $GET(IBSORTOR(SORT))="D"
SET VALUE=-VALUE
SVX QUIT VALUE
+1 ;
+2 ;
ZZ ; List of allowable sort criteria
ZZ1 ;;1:Last Transmitted Date:1:IBLTRDT;
ZZ2 ;;2:Payer:0:IBPAY;
ZZ3 ;;3:EDI Claim Status:0:IBEDIST;
ZZ4 ;;4:Current Balance:1:IBCURBAL;
ZZ5 ;;5:Division:0:IBDIV;
ZZ6 ;;6:Claim Number:0:IBEXTCLM;
ZZ7 ;;7:AR Status:0:IBARSTAT;
ZZ8 ;;8:Age:1:IBAGE;
+1 ;
