source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEDS1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1IBCEDS1 ;ALB/ESG - EDI CLAIM STATUS REPORT - SELECTION CONT ;13-DEC-2007
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7SORTSEL(LVL) ; sort selection criteria
8 ; LVL - sort level 1, 2, or 3
9 ;
10 NEW DIR,X,Y,LVLD,G,LN,S,SC,SCP,DTOUT,DUOUT,DIRUT,DIROUT,IBZ
11 K IBSORT3 I LVL<3 K IBSORT2 I LVL=1 K IBSORT1
12 I '$F(".1.2.3.","."_$G(LVL)_".") G SORTSELX
13 I STOP G SORTSELX
14 ;
15 I LVL>1,$G(IBSORT1)="" D SORTSEL(1) I $G(IBSORT1)="" G SORTSELX
16 I LVL=3,$G(IBSORT2)="" D SORTSEL(2) I $G(IBSORT2)="" G SORTSELX
17 ;
18 S LVLD=$S(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
19 ;
20 S DIR("A")=LVLD_" Sort"
21 I LVL=1 S DIR("B")=$$SD("1")
22 I LVL>1 K DIR("B")
23 ;
24 S DIR("?")="Enter a code from the list to indicate the "_LVLD_" sort order."
25 I LVL>1 S DIR("?",1)=" Primary Sort is "_$$SD($G(IBSORT1)),DIR("?",LVL)=""
26 I LVL=3 S DIR("?",2)="Secondary Sort is "_$$SD($G(IBSORT2))
27 ;
28 I LVL=1 S DIR(0)="SB" ; primary sort required
29 I LVL>1 S DIR(0)="SOB" ; optional sorts
30 ;
31 S G=""
32 F LN=1:1 S S=$P($T(ZZ+LN),";",3) Q:S="" D
33 . S SC=$P(S,":",1) ; sort code
34 . I LVL=2,IBSORT1=SC Q
35 . I LVL=3,IBSORT1=SC!(IBSORT2=SC) Q
36 . S SCP=$P(S,":",1,2) ; sort code:desc pair
37 . S G=$S(G="":SCP,1:G_";"_SCP)
38 . Q
39 ;
40 S $P(DIR(0),U,2)=G
41 ;
42 D ^DIR K DIR
43 I $D(DTOUT)!$D(DUOUT) S STOP=1 G SORTSELX ; timeout or up arrow
44 I Y="" G SORTSELX ; null response
45 S @("IBSORT"_LVL)=Y,IBZ=Y
46 ;
47 I IBZ="4" D G SORTSELX ; current balance question
48 . S DIR(0)="Y"
49 . S DIR("A")="Display Highest Balances First",DIR("B")="Yes"
50 . S DIR("A",1)=""
51 . S DIR("?",1)="Enter Yes or No."
52 . S DIR("?",2)=""
53 . S DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
54 . S DIR("?",4)="small balances last at the bottom of the list."
55 . S DIR("?",5)=""
56 . S DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
57 . S DIR("?")="large balances last at the bottom of the list."
58 . D ^DIR K DIR
59 . I $D(DTOUT) S STOP=1 Q ; timeout
60 . I $D(DIRUT) S:LVL=1 STOP=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
61 . I Y S IBSORTOR(IBZ)="D" ; yes, large first, descending
62 . I 'Y S IBSORTOR(IBZ)="A" ; no, small first, ascending
63 . Q
64 ;
65 I IBZ="1" D G SORTSELX ; Last Transmitted Date Question
66 . S DIR(0)="Y"
67 . S DIR("A")="Display Oldest EDI Claims First",DIR("B")="Yes"
68 . S DIR("A",1)=""
69 . S DIR("?",1)="Enter Yes to display claims with oldest transmission dates first."
70 . S DIR("?")="Enter No to display claims with recent transmission dates first."
71 . D ^DIR K DIR
72 . I $D(DTOUT) S STOP=1 Q ; timeout
73 . I $D(DIRUT) S:LVL=1 STOP=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
74 . I Y S IBSORTOR(IBZ)="A" ; yes, old first, ascending sort
75 . I 'Y S IBSORTOR(IBZ)="D" ; no, new first, descending sort
76 . Q
77 ;
78 I IBZ="8" D G SORTSELX ; Age Question
79 . S DIR(0)="Y"
80 . S DIR("A")="Display Oldest EDI Claims First",DIR("B")="Yes"
81 . S DIR("A",1)=""
82 . S DIR("?",1)="Enter Yes or No."
83 . S DIR("?",2)=""
84 . S DIR("?",3)="Yes, I want to see old EDI claims first at the top of the list and newer"
85 . S DIR("?",4)="EDI claims last at the bottom of the list."
86 . S DIR("?",5)=""
87 . S DIR("?",6)="No, I want to see new EDI claims first at the top of the list and older"
88 . S DIR("?",7)="EDI claims last at the bottom of the list."
89 . S DIR("?",8)=""
90 . S DIR("?",9)="Note:"
91 . S DIR("?",10)="For MRA request claims, AGE is calculated as the number of days from the MRA"
92 . S DIR("?",11)="request date through today's date."
93 . S DIR("?",12)=""
94 . S DIR("?",13)="For all other claims, AGE is calculated as the number of days from the"
95 . S DIR("?")="Authorization date through today's date."
96 . D ^DIR K DIR
97 . I $D(DTOUT) S STOP=1 Q ; timeout
98 . I $D(DIRUT) S:LVL=1 STOP=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
99 . I Y S IBSORTOR(IBZ)="D" ; yes, old first, high age#'s first, descending
100 . I 'Y S IBSORTOR(IBZ)="A" ; no, new first, low age#'s first, ascending
101 . Q
102 ;
103SORTSELX ;
104 Q
105 ;
106SD(SORT) ; sort description given the sort code
107 Q $P($P($T(@("ZZ"_$G(SORT))),";",3),":",2)
108 ;
109SV(SORT,DEF) ; sort value given the sort code
110 ; SORT - sort code
111 ; DEF - default value if the sort code is nil (must be non-nil)
112 ;
113 NEW S,VAR,VALUE
114 I $G(SORT)="" S VALUE=DEF G SVX
115 S S=$P($T(@("ZZ"_$G(SORT))),";",3)
116 S VAR=$P(S,":",4) ; variable name
117 S VALUE=$G(@VAR) ; value of variable
118 I VALUE="" S VALUE="~" G SVX ; get out if undefined
119 I '$P(S,":",3) G SVX ; non-numeric
120 I $G(IBSORTOR(SORT))="D" S VALUE=-VALUE ; descending sort
121SVX Q VALUE
122 ;
123 ;
124ZZ ; List of allowable sort criteria
125ZZ1 ;;1:Last Transmitted Date:1:IBLTRDT;
126ZZ2 ;;2:Payer:0:IBPAY;
127ZZ3 ;;3:EDI Claim Status:0:IBEDIST;
128ZZ4 ;;4:Current Balance:1:IBCURBAL;
129ZZ5 ;;5:Division:0:IBDIV;
130ZZ6 ;;6:Claim Number:0:IBEXTCLM;
131ZZ7 ;;7:AR Status:0:IBARSTAT;
132ZZ8 ;;8:Age:1:IBAGE;
133 ;
Note: See TracBrowser for help on using the repository browser.