source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEX0.m@ 642

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1RCDPEX0 ;ALB/TMK - 837 EDI RETURN MSG EXTRACT MAIN LIST TEMPLATE ;02-MAY-96
2 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SCRIT(RCSCRIT) ; Enter display selection criteria
6 ; Pass RCSCRIT by reference - returned containing selection criteria
7 ; RCSCRIT(n)=n-level sort RCSCRIT(n,1-x)=selections
8 ; RCSCRIT(n,"D1") = from DATE range RCSCRIT(n,"D2") = to DATE range
9 N DIR,X,Y
10 D FULL^VALM1
11 W !
12 S DIR("B")="ALL"
13 S DIR("A",1)="Enter sort and selection criteria for message list",DIR("A",2)=" ",DIR("A")="First level sort field: "
14 S DIR(0)="SA^MT:TYPE OF MESSAGE;ER:TYPE OF ERROR;ALL:ALL MESSAGES"
15 S DIR("?")="Enter the top-level sort for the list of messages"
16 D ^DIR K DIR
17 I $D(DIRUT) K RCSCRIT Q
18 S RCSCRIT(1)=Y
19 I Y="ALL" Q
20 D SELECT(1,.RCSCRIT) Q:'$D(RCSCRIT)
21 S DIR("A",1)=" ",DIR("A")="Second level sort field: "
22 S DIR(0)="SAO^"_$S($S(RCSCRIT(1)'="MT":"MT:TYPE OF MESSAGE;",1:"")_RCSCRIT(1)'="MS":"ER:TYPE OF ERROR;",1:"")_"MD:ERA MESSAGE DATE;RD:ERA RECORDED DATE"
23 S DIR("?")="Enter the second-level sort for the list of messages"
24 S DIR("?",1)="First level sort selected was: "_$$FLD(RCSCRIT(1))
25 D ^DIR K DIR
26 I $D(DTOUT)!$D(DUOUT) K RCSCRIT Q
27 I Y="" Q
28 S RCSCRIT(2)=Y
29 D SELECT(2,.RCSCRIT) Q:'$D(RCSCRIT)
30 S DIR("A",1)=" ",DIR("A")="Third level sort field: "
31 S DIR(0)="SAO^"
32 S DIR(0)=DIR(0)_$S(RCSCRIT(1)'="MT"&(RCSCRIT(2)'="MT"):"MT:TYPE OF MESSAGE;",1:"")_$S(RCSCRIT(1)'="ER"&(RCSCRIT(2)'="ER"):"ER:TYPE OF ERROR",1:"")
33 S DIR(0)=DIR(0)_$S(RCSCRIT(2)'="MD":"MD:ERA MESSAGE DATE;",1:"")_$S(RCSCRIT(2)'="RD":"RD:ERA RECORDED DATE",1:"")
34 S DIR("?")="Enter the third-level sort for the list of messages"
35 D ^DIR K DIR
36 I $D(DTOUT)!$D(DUOUT) K RCSCRIT Q
37 I Y="" Q
38 S RCSCRIT(3)=Y
39 D SELECT(3,.RCSCRIT)
40 Q
41 ;
42SELECT(LEVEL,RCSCRIT) ; Select specific or all values/date range for RCSCRIT(LEVEL)
43 ; LEVEL = sort level 1-3
44 N SELNM,SEL,CT,Y,DIR,DUOUT,DTOUT,DIRUT,X,Z
45 S SEL=$G(RCSCRIT(LEVEL)) I SEL="" K RCSCRIT Q
46 S SELNM=$$FLD(SEL)
47RESEL S DIR("A")="Do you want ALL "_SELNM_"'s",DIR(0)="Y",DIR("?")="ANSWER YES TO INCLUDE ALL "_SELNM_" OR NO TO SELECT SPECIFIC VALUES OR RANGES"
48 D ^DIR K DIR
49 I $D(DIRUT) K RCSCRIT Q
50 I Y=1 Q
51 I SEL="MD"!(SEL="RD") D Q ;Date field
52 . S DIR("A")="From Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the earliest date you want included in the list" D ^DIR
53 . I $D(DIRUT) K RCSCRIT Q
54 . S RCSCRIT(LEVEL,"D1")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
55 . S DIR("A")="To Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the latest date you want included in the list" D ^DIR
56 . I $D(DIRUT) K RCSCRIT Q
57 . S RCSCRIT(LEVEL,"D2")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
58 S CT=0
59 S DIR("A",1)=" ",DIR("A",2)="Enter your selections one at a time.",DIR("A",3)="When done, press return at the "_SELNM_" prompt to continue."
60 S DIR("A")=SELNM_": ",DIR(0)=$S(SEL="ER":"344.5,.1",SEL="MT":"344.5,.02",1:"")_"AO"
61 F D ^DIR D Q:"^"[Y
62 . Q:$D(DUOUT)
63 . I Y="" Q:CT W !,*7,"You must select at least one entry" S Y=-1 Q
64 . S CT=CT+1,RCSCRIT(LEVEL,$P(Y,U))=Y
65 . I $D(DIR("A",1)) F Z=1:1:3 K DIR("A",Z)
66 K DIR
67 I $D(DUOUT)!$D(DTOUT) D I $D(RCSCRIT) K RCSCRIT(LEVEL) S RCSCRIT(LEVEL)=SEL G RESEL
68 . S DIR(0)="Y",DIR("A",1)=" ",DIR("A")="Do you want to abort this entire sort/selection"
69 . S DIR("?")="Answer YES if you want to abort or to re-enter all sort/selection criteria",DIR("?",1)="Answer NO if you want to re-enter just this sort level's criteria"
70 . D ^DIR K DIR
71 . I $D(DIRUT)!Y K RCSCRIT
72 Q
73 ;
74FLD(FLD) ; RETURN NAME OF FIELD
75 Q $S(FLD="ER":"ERROR CATEGORY",FLD="MT":"TYPE OF MESSAGE",FLD="MD":"MESSAGE DATE",FLD="RD":"DATE RECORDED",1:"")
76 ;
Note: See TracBrowser for help on using the repository browser.