source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDSS1.m@ 1753

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1ECDSS1 ;BIR/RHK,JPW-Active/Inactive Procedure Report ; 5/22/01 10:32am
2 ;;2.0; EVENT CAPTURE ;**4,25**;8 May 96
3 ; Routine to report active and inactive procedures
4START ; Routine execution
5 N ECRAS S ECRAS=1 ;roll and scroll
6 S DIR(0)="SO^A:Active Procedures;I:Inactive Procedures"
7 S DIR("A")="Select Report"
8 S DIR("?")="Enter an A for active procedures, I for inactive procedures, or ^ to quit."
9 S DIR("??")="ECDSS1^"
10 D ^DIR K DIR I $D(DIRUT) G END
11 S ECRTN=Y
12INACT ;list inact procs
13 I ECRTN="I" D LISTI G END
14ASK ;
15 S DIR(0)="SO^N:National;L:Local;B:Both",DIR("A")="Select Preferred Report"
16 S DIR("?,1")="Enter an N for National Procedures only, L for Local Procedures only,"
17 S DIR("?")="B for a combined report, or ^ to quit."
18 S DIR("??")="ECDSAC^" D ^DIR K DIR I $D(DIRUT) G END
19 S ECRN=Y
20SORT ;ask sort
21 S DIR(0)="SO^P:Procedure Name;N:National Number",DIR("A")="Select Sort Method"
22 S DIR("?")="Enter N to sort by National Number, P by Procedure Name, or ^ to quit."
23 S DIR("??")="ECDSAC1^" D ^DIR K DIR I $D(DIRUT) G END
24 S ECRD=Y
25PRT ;start prints
26 I ECRN="N",ECRD="N" D LISTNN G END
27 I ECRN="N",ECRD="P" D LISTNP G END
28 I ECRN="L",ECRD="N" D LISTPN G END
29 I ECRN="L",ECRD="P" D LISTPP G END
30 I ECRN="B",ECRD="N" D LISTBN G END
31 I ECRN="B",ECRD="P" D LISTBP
32END ;kills var and quit
33 W @IOF D ^ECKILL
34 Q
35LISTI ;all inact proc
36 W ! K DIC S DIC="^EC(725,",FLDS=".01,1,4,2",BY=".01",(FR,TO)="",L=0,DHD="EVENT CAPTURE INACTIVE PROCEDURES",DIS(0)="I +$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
37 D MSG
38 Q
39LISTNN ;nat only by nat num
40 W ! K DIC S DIC="^EC(725,",FLDS="1,4,.01",BY="1",(FR,TO)="",L=0,DHD="EVENT CAPTURE NATIONAL PROCEDURES BY NATIONAL NUMBER",DIS(0)="I D0<90000,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
41 D MSG
42 Q
43LISTNP ;nat only by proc
44 W ! K DIC S DIC="^EC(725,",FLDS=".01,1,4",BY=".01",(FR,TO)="",L=0,DHD="EVENT CAPTURE NATIONAL PROCEDURES BY PROCEDURE",DIS(0)="I D0<90000,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
45 D MSG
46 Q
47LISTPN ;loc by nat num
48 W ! K DIC S DIC="^EC(725,",FLDS="1,4,.01",BY="1",(FR,TO)="",L=0,DHD="EVENT CAPTURE LOCAL PROCEDURES BY NATIONAL NUMBER",DIS(0)="I D0>89999,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
49 D MSG
50 Q
51LISTPP ;loc by proc
52 W ! K DIC S DIC="^EC(725,",FLDS=".01,1,4",BY=".01",(FR,TO)="",L=0,DHD="EVENT CAPTURE LOCAL PROCEDURES BY PROCEDURE",DIS(0)="I D0>89999,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
53 D MSG
54 Q
55LISTBN ;both by nat num
56 W ! K DIC S DIC="^EC(725,",FLDS="1,4,.01",BY="1",(FR,TO)="",L=0,DHD="EVENT CAPTURE PROCEDURES BY NATIONAL NUMBER",DIS(0)="I '$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
57 D MSG
58 Q
59LISTBP ;both by proc
60 W ! K DIC S DIC="^EC(725,",FLDS=".01,1,4",BY=".01",(FR,TO)="",L=0,DHD="EVENT CAPTURE PROCEDURES (ALL) BY PROCEDURE",DIS(0)="I '$P(^EC(725,D0,0),""^"",3)" D EN1^DIP
61 D MSG
62 Q
63MSG I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
64 Q
Note: See TracBrowser for help on using the repository browser.