source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCUEDS.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1FSCUEDS ;SLC/STAFF-NOIS Utilities Edit Schedules ;7/12/95 14:36
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4FILES ; from FSCOPT
5 N DIR,FILE,X,Y K DIR
6 S DIR(0)="SAMO^SCHEDULES:SCHEDULES;EVENTS:EVENTS;RECURRING EVENTS:RECURRING EVENTS"
7 S DIR("?",1)="Enter the file you wish to review."
8 S DIR("?")="^D HELP^FSCU(.DIR)"
9 S DIR("??")="FSC U1 NOIS"
10 W !,"These are files you can review.",!
11 S DIR("A",1)=" Schedule"
12 S DIR("A",2)=" Events"
13 S DIR("A",3)=" Recurring Events"
14 S DIR("A",4)=""
15 S DIR("A")="Select file: "
16 D ^DIR K DIR
17 I $D(DIRUT) Q
18 I '$L(Y) Q
19 S FILE=Y
20 N DIR,TRAN,X,Y K DIR
21 S TRAN=0 I FILE["EVENT",$$ACCESS^FSCU(DUZ,"SUPER") S TRAN=1
22 S DIR(0)="SAMO^PRINT:PRINT;SEARCH:SEARCH;INQUIRE:INQUIRE"_$S(TRAN:";TRANSFER:TRANSFER;DELETE:DELETE",1:"")
23 S DIR("A")="Select (P)rint, (S)earch, (I)nquire/Edit"_$S(TRAN:", (T)ransfer, (D)elete",1:"")_": "
24 S DIR("?",1)="Enter PRINT to print the file."
25 S DIR("?",2)="Enter SEARCH the file."
26 S DIR("?",3)="Enter INQUIRE to inquire on the file."
27 S DIR("?")="^D HELP^FSCU(.DIR)"
28 S DIR("??")="FSC U1 NOIS"
29 D ^DIR K DIR
30 I $D(DIRUT) Q
31 I '$L(Y) Q
32 I Y="PRINT" D PRINT(FILE) Q
33 I Y="SEARCH" D SEARCH(FILE) Q
34 I Y="INQUIRE" D Q
35 .I '$$ACCESS^FSCU(DUZ,"SUPER") D
36 ..N DIR,X,Y K DIR
37 ..S DIR(0)="SAMO^INQUIRE:INQUIRE;NEW:NEW"
38 ..S DIR("A")="Select (I)nquire/Edit or (N)ew: "
39 ..S DIR("B")="INQUIRE"
40 ..S DIR("?",1)="Enter INQUIRE to inquire on the file."
41 ..S DIR("?",2)="Enter NEW to make a new entry."
42 ..S DIR("?")="^D HELP^FSCU(.DIR)"
43 ..S DIR("??")="FSC U1 NOIS"
44 ..D ^DIR K DIR
45 ..I $D(DIRUT) Q
46 ..I '$L(Y) Q
47 ..I Y="INQUIRE" D INQUIRE(FILE) Q
48 ..I Y="NEW" D NEW Q
49 .E D INQUIRE(FILE) Q
50 I Y="TRANSFER" D ADD^FSCEVENT Q
51 I Y="DELETE" D DEL^FSCEVENT Q
52 Q
53 ;
54NEW ;
55 N DIR,END,START,X,Y K DIR
56 S START=$E(DT,1,3)-1_"0101",END=$E(DT,1,3)+1_"1201"
57 S DIR(0)="DAO^"_START_":"_END_":EX"
58 S DIR("?",1)="Enter the schedule date."
59 S DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
60 S DIR("??")="FSC U1 NOIS"
61 S DIR("A")="Select Date: "
62 D ^DIR K DIR
63 I $D(DIRUT) Q
64 I '$L(Y) Q
65 S X=Y
66 N DIC,DO,Y K DIC,DO,Y
67 S DIC="^FSCD(""SCHEDULE"",",DIC(0)="AEMQL",DIC("DR")="1///^S X=DUZ;2:999"
68 D FILE^DICN K DIC,Y
69 Q
70 ;
71PRINT(FILE) ;
72 N DIC,L
73 I FILE="SCHEDULES" S DIC="^FSCD(""SCHEDULE"","
74 I FILE="EVENTS" S DIC="^FSCD(""EVENTS"","
75 I FILE="RECURRING EVENTS" S DIC="^FSC(""REVENT"","
76 S L="LIST "_$P(@(DIC_"0)"),U)
77 D EN1^DIP
78 Q
79 ;
80SEARCH(FILE) ;
81 N DIC
82 I FILE="SCHEDULES" S DIC="^FSCD(""SCHEDULE"","
83 I FILE="EVENTS" S DIC="^FSCD(""EVENTS"","
84 I FILE="RECURRING EVENTS" S DIC="^FSC(""REVENT"","
85 D EN^DIS
86 Q
87 ;
88INQUIRE(FILE) ;
89 N CONTINUE,DIC K DIC S CONTINUE=1
90 I FILE="SCHEDULES" S DIC="^FSCD(""SCHEDULE"",",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ!$$ACCESS^FSCU(DUZ,""SUPER"")"
91 I FILE="EVENTS" S DIC="^FSCD(""EVENTS"",",DIC(0)="AEMQ"
92 I FILE="RECURRING EVENTS" S DIC="^FSC(""REVENT"",",DIC(0)="AEMQ"
93 I DIC(0)'["L",$$ACCESS^FSCU(DUZ,"SUPER") S DIC(0)=DIC(0)_"L"
94 N ZERODIC S ZERODIC=DIC(0)
95 F D I 'CONTINUE Q
96 .N ENTRY,EDIT,DR,OK
97 .S DIC(0)=ZERODIC
98 .S OK=1 W ! D ^DIC I Y<1 S OK=0
99 .I 'OK S CONTINUE=0 Q
100 .S ENTRY=Y,EDIT=DIC
101 .D SHOW(EDIT,+ENTRY,.OK)
102 .I '$$ACCESS^FSCU(DUZ,"SUPER"),DIC["EVENT" D PAUSE^FSCU(.OK) Q
103 .S DR=".01:999"
104 .I DIC["SCHEDULE",'$$ACCESS^FSCU(DUZ,"SUPER") S DR=".01;2:999"
105 .D EDIT(EDIT,+ENTRY,DR,.OK)
106 Q
107EDIT(EDIT,DA,DR,OK) ;
108 N DIE,GBL S OK=1
109 D FILE(EDIT,DA,.DIE,.GBL,.OK)
110 I 'OK Q
111 L +@GBL:30 I '$T W !,"Unable to edit." Q
112 D ^DIE
113 L -@GBL
114 Q
115 ;
116FILE(DIC,ENTRY,DIE,GBL,OK) ;
117 S OK=0
118 I '$D(@(DIC_"0)")) Q
119 S DIE=DIC,GBL=DIE_ENTRY_")",OK=1
120 Q
121 ;
122SHOW(DIC,DA,OK) ;
123 S OK=0
124 I '$D(@(DIC_"0)")) Q
125 D EN^DIQ S OK=1
126 Q
Note: See TracBrowser for help on using the repository browser.