source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM2.m@ 1742

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1IBCEM2 ;ALB/TMP - 837 EDI RETURN MSG EXTRACT MAIN LIST TEMPLATE ;02-MAY-96
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
3 ;
4SCRIT(IBSCRIT) ; Enter display selection criteria
5 ; Pass IBSCRIT by reference - returned containing selection criteria
6 ; IBSCRIT(n)=n-level sort IBSCRIT(n,1-x)=selections
7 ; IBSCRIT(n,"D1") = from DATE range IBSCRIT(n,"D2") = to DATE range
8 D FULL^VALM1
9 W !
10 S DIR("B")="ALL"
11 S DIR("A",1)="Enter sort and selection criteria for message list",DIR("A",2)=" ",DIR("A")="First level sort field: "
12 S DIR(0)="SA^MS:MESSAGE STATUS;MT:TYPE OF MESSAGE;BA:BATCH #;BI:BILL #;ALL:ALL MESSAGES"
13 S DIR("?")="Enter the top-level sort for the list of messages"
14 D ^DIR K DIR
15 I $D(DIRUT) K IBSCRIT Q
16 S IBSCRIT(1)=Y
17 I Y="ALL" Q
18 D SELECT(1,.IBSCRIT) Q:'$D(IBSCRIT)
19 S DIR("A",1)=" ",DIR("A")="Second level sort field: "
20 S DIR(0)="SAO^"_$S(IBSCRIT(1)'="MS":"MS:MESSAGE STATUS;",1:"")_$S(IBSCRIT(1)'="MT":"MT:TYPE OF MESSAGE;",1:"")_"MD:MESSAGE DATE;RD:RECORDED DATE"
21 S DIR("?")="Enter the second-level sort for the list of messages"
22 S DIR("?",1)="First level sort selected was: "_$$FLD(IBSCRIT(1))
23 D ^DIR K DIR
24 I $D(DTOUT)!$D(DUOUT) K IBSCRIT Q
25 I Y="" Q
26 S IBSCRIT(2)=Y
27 D SELECT(2,.IBSCRIT) Q:'$D(IBSCRIT)
28 S DIR("A",1)=" ",DIR("A")="Third level sort field: "
29 S DIR(0)="SAO^"
30 S DIR(0)=DIR(0)_$S(IBSCRIT(1)'="MS"&(IBSCRIT(2)'="MS"):"MS:MESSAGE STATUS;",1:"")_$S(IBSCRIT(1)'="MT"&(IBSCRIT(2)'="MT"):"MT:TYPE OF MESSAGE;",1:"")
31 S DIR(0)=DIR(0)_$S(IBSCRIT(2)'="MD":"MD:MESSAGE DATE;",1:"")_$S(IBSCRIT(2)'="RD":"RD:RECORDED DATE",1:"")
32 S DIR("?")="Enter the third-level sort for the list of messages"
33 D ^DIR K DIR
34 I $D(DTOUT)!$D(DUOUT) K IBSCRIT Q
35 I Y="" Q
36 S IBSCRIT(3)=Y
37 D SELECT(3,.IBSCRIT)
38 Q
39 ;
40SELECT(LEVEL,IBSCRIT) ; Select specific or all values/date range for IBSCRIT(LEVEL)
41 ; LEVEL = sort level 1-3
42 N SELNM,SEL,CT,Y,DIR,DUOUT,DTOUT,DIRUT,Z
43 S SEL=$G(IBSCRIT(LEVEL)) I SEL="" K IBSCRIT Q
44 S SELNM=$$FLD(SEL)
45RESEL 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"
46 D ^DIR K DIR
47 I $D(DIRUT) K IBSCRIT Q
48 I Y=1 Q
49 I SEL="MD"!(SEL="RD") D Q ;Date field
50 . S DIR("A")="From Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the earliest date you want included in the list" D ^DIR
51 . I $D(DIRUT) K IBSCRIT Q
52 . S IBSCRIT(LEVEL,"D1")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
53 . S DIR("A")="To Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the latest date you want included in the list" D ^DIR
54 . I $D(DIRUT) K IBSCRIT Q
55 . S IBSCRIT(LEVEL,"D2")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
56 S CT=0
57 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."
58 S DIR("A")=SELNM_": ",DIR(0)=$S(SEL="MS":"364.2,.06",SEL="MT":"364.2,.02",SEL="BA":"364.2,.04",SEL="BI":"364,.01",1:"")_"AO"
59 F D ^DIR D Q:"^"[Y
60 . Q:$D(DUOUT)
61 . I Y="" Q:CT W !,*7,"You must select at least one entry" S Y=-1 Q
62 . S CT=CT+1,IBSCRIT(LEVEL,$P(Y,U))=Y
63 . I $D(DIR("A",1)) F Z=1:1:3 K DIR("A",Z)
64 K DIR
65 I $D(DUOUT)!$D(DTOUT) D I $D(IBSCRIT) K IBSCRIT(LEVEL) S IBSCRIT(LEVEL)=SEL G RESEL
66 . S DIR(0)="Y",DIR("A",1)=" ",DIR("A")="Do you want to abort this entire sort/selection"
67 . 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"
68 . D ^DIR K DIR
69 . I $D(DIRUT)!Y K IBSCRIT
70 Q
71 ;
72FLD(FLD) ; RETURN NAME OF FIELD
73 Q $S(FLD="MS":"MESSAGE STATUS",FLD="MT":"TYPE OF MESSAGE",FLD="BA":"BATCH",FLD="BI":"BILL",FLD="MD":"MESSAGE DATE",FLD="RD":"DATE RECORDED",1:"")
74 ;
Note: See TracBrowser for help on using the repository browser.