FSCUEDS ;SLC/STAFF-NOIS Utilities Edit Schedules ;7/12/95 14:36
;;1.1;NOIS;;Sep 06, 1998
;
FILES ; from FSCOPT
N DIR,FILE,X,Y K DIR
S DIR(0)="SAMO^SCHEDULES:SCHEDULES;EVENTS:EVENTS;RECURRING EVENTS:RECURRING EVENTS"
S DIR("?",1)="Enter the file you wish to review."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
W !,"These are files you can review.",!
S DIR("A",1)=" Schedule"
S DIR("A",2)=" Events"
S DIR("A",3)=" Recurring Events"
S DIR("A",4)=""
S DIR("A")="Select file: "
D ^DIR K DIR
I $D(DIRUT) Q
I '$L(Y) Q
S FILE=Y
N DIR,TRAN,X,Y K DIR
S TRAN=0 I FILE["EVENT",$$ACCESS^FSCU(DUZ,"SUPER") S TRAN=1
S DIR(0)="SAMO^PRINT:PRINT;SEARCH:SEARCH;INQUIRE:INQUIRE"_$S(TRAN:";TRANSFER:TRANSFER;DELETE:DELETE",1:"")
S DIR("A")="Select (P)rint, (S)earch, (I)nquire/Edit"_$S(TRAN:", (T)ransfer, (D)elete",1:"")_": "
S DIR("?",1)="Enter PRINT to print the file."
S DIR("?",2)="Enter SEARCH the file."
S DIR("?",3)="Enter INQUIRE to inquire on the file."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) Q
I '$L(Y) Q
I Y="PRINT" D PRINT(FILE) Q
I Y="SEARCH" D SEARCH(FILE) Q
I Y="INQUIRE" D Q
.I '$$ACCESS^FSCU(DUZ,"SUPER") D
..N DIR,X,Y K DIR
..S DIR(0)="SAMO^INQUIRE:INQUIRE;NEW:NEW"
..S DIR("A")="Select (I)nquire/Edit or (N)ew: "
..S DIR("B")="INQUIRE"
..S DIR("?",1)="Enter INQUIRE to inquire on the file."
..S DIR("?",2)="Enter NEW to make a new entry."
..S DIR("?")="^D HELP^FSCU(.DIR)"
..S DIR("??")="FSC U1 NOIS"
..D ^DIR K DIR
..I $D(DIRUT) Q
..I '$L(Y) Q
..I Y="INQUIRE" D INQUIRE(FILE) Q
..I Y="NEW" D NEW Q
.E D INQUIRE(FILE) Q
I Y="TRANSFER" D ADD^FSCEVENT Q
I Y="DELETE" D DEL^FSCEVENT Q
Q
;
NEW ;
N DIR,END,START,X,Y K DIR
S START=$E(DT,1,3)-1_"0101",END=$E(DT,1,3)+1_"1201"
S DIR(0)="DAO^"_START_":"_END_":EX"
S DIR("?",1)="Enter the schedule date."
S DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
S DIR("A")="Select Date: "
D ^DIR K DIR
I $D(DIRUT) Q
I '$L(Y) Q
S X=Y
N DIC,DO,Y K DIC,DO,Y
S DIC="^FSCD(""SCHEDULE"",",DIC(0)="AEMQL",DIC("DR")="1///^S X=DUZ;2:999"
D FILE^DICN K DIC,Y
Q
;
PRINT(FILE) ;
N DIC,L
I FILE="SCHEDULES" S DIC="^FSCD(""SCHEDULE"","
I FILE="EVENTS" S DIC="^FSCD(""EVENTS"","
I FILE="RECURRING EVENTS" S DIC="^FSC(""REVENT"","
S L="LIST "_$P(@(DIC_"0)"),U)
D EN1^DIP
Q
;
SEARCH(FILE) ;
N DIC
I FILE="SCHEDULES" S DIC="^FSCD(""SCHEDULE"","
I FILE="EVENTS" S DIC="^FSCD(""EVENTS"","
I FILE="RECURRING EVENTS" S DIC="^FSC(""REVENT"","
D EN^DIS
Q
;
INQUIRE(FILE) ;
N CONTINUE,DIC K DIC S CONTINUE=1
I FILE="SCHEDULES" S DIC="^FSCD(""SCHEDULE"",",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ!$$ACCESS^FSCU(DUZ,""SUPER"")"
I FILE="EVENTS" S DIC="^FSCD(""EVENTS"",",DIC(0)="AEMQ"
I FILE="RECURRING EVENTS" S DIC="^FSC(""REVENT"",",DIC(0)="AEMQ"
I DIC(0)'["L",$$ACCESS^FSCU(DUZ,"SUPER") S DIC(0)=DIC(0)_"L"
N ZERODIC S ZERODIC=DIC(0)
F D I 'CONTINUE Q
.N ENTRY,EDIT,DR,OK
.S DIC(0)=ZERODIC
.S OK=1 W ! D ^DIC I Y<1 S OK=0
.I 'OK S CONTINUE=0 Q
.S ENTRY=Y,EDIT=DIC
.D SHOW(EDIT,+ENTRY,.OK)
.I '$$ACCESS^FSCU(DUZ,"SUPER"),DIC["EVENT" D PAUSE^FSCU(.OK) Q
.S DR=".01:999"
.I DIC["SCHEDULE",'$$ACCESS^FSCU(DUZ,"SUPER") S DR=".01;2:999"
.D EDIT(EDIT,+ENTRY,DR,.OK)
Q
EDIT(EDIT,DA,DR,OK) ;
N DIE,GBL S OK=1
D FILE(EDIT,DA,.DIE,.GBL,.OK)
I 'OK Q
L +@GBL:30 I '$T W !,"Unable to edit." Q
D ^DIE
L -@GBL
Q
;
FILE(DIC,ENTRY,DIE,GBL,OK) ;
S OK=0
I '$D(@(DIC_"0)")) Q
S DIE=DIC,GBL=DIE_ENTRY_")",OK=1
Q
;
SHOW(DIC,DA,OK) ;
S OK=0
I '$D(@(DIC_"0)")) Q
D EN^DIQ S OK=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCUEDS 3719 printed Oct 16, 2024@18:21:01 Page 2
FSCUEDS ;SLC/STAFF-NOIS Utilities Edit Schedules ;7/12/95 14:36
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
FILES ; from FSCOPT
+1 NEW DIR,FILE,X,Y
KILL DIR
+2 SET DIR(0)="SAMO^SCHEDULES:SCHEDULES;EVENTS:EVENTS;RECURRING EVENTS:RECURRING EVENTS"
+3 SET DIR("?",1)="Enter the file you wish to review."
+4 SET DIR("?")="^D HELP^FSCU(.DIR)"
+5 SET DIR("??")="FSC U1 NOIS"
+6 WRITE !,"These are files you can review.",!
+7 SET DIR("A",1)=" Schedule"
+8 SET DIR("A",2)=" Events"
+9 SET DIR("A",3)=" Recurring Events"
+10 SET DIR("A",4)=""
+11 SET DIR("A")="Select file: "
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
QUIT
+14 IF '$LENGTH(Y)
QUIT
+15 SET FILE=Y
+16 NEW DIR,TRAN,X,Y
KILL DIR
+17 SET TRAN=0
IF FILE["EVENT"
IF $$ACCESS^FSCU(DUZ,"SUPER")
SET TRAN=1
+18 SET DIR(0)="SAMO^PRINT:PRINT;SEARCH:SEARCH;INQUIRE:INQUIRE"_$SELECT(TRAN:";TRANSFER:TRANSFER;DELETE:DELETE",1:"")
+19 SET DIR("A")="Select (P)rint, (S)earch, (I)nquire/Edit"_$SELECT(TRAN:", (T)ransfer, (D)elete",1:"")_": "
+20 SET DIR("?",1)="Enter PRINT to print the file."
+21 SET DIR("?",2)="Enter SEARCH the file."
+22 SET DIR("?",3)="Enter INQUIRE to inquire on the file."
+23 SET DIR("?")="^D HELP^FSCU(.DIR)"
+24 SET DIR("??")="FSC U1 NOIS"
+25 DO ^DIR
KILL DIR
+26 IF $DATA(DIRUT)
QUIT
+27 IF '$LENGTH(Y)
QUIT
+28 IF Y="PRINT"
DO PRINT(FILE)
QUIT
+29 IF Y="SEARCH"
DO SEARCH(FILE)
QUIT
+30 IF Y="INQUIRE"
Begin DoDot:1
+31 IF '$$ACCESS^FSCU(DUZ,"SUPER")
Begin DoDot:2
+32 NEW DIR,X,Y
KILL DIR
+33 SET DIR(0)="SAMO^INQUIRE:INQUIRE;NEW:NEW"
+34 SET DIR("A")="Select (I)nquire/Edit or (N)ew: "
+35 SET DIR("B")="INQUIRE"
+36 SET DIR("?",1)="Enter INQUIRE to inquire on the file."
+37 SET DIR("?",2)="Enter NEW to make a new entry."
+38 SET DIR("?")="^D HELP^FSCU(.DIR)"
+39 SET DIR("??")="FSC U1 NOIS"
+40 DO ^DIR
KILL DIR
+41 IF $DATA(DIRUT)
QUIT
+42 IF '$LENGTH(Y)
QUIT
+43 IF Y="INQUIRE"
DO INQUIRE(FILE)
QUIT
+44 IF Y="NEW"
DO NEW
QUIT
End DoDot:2
+45 IF '$TEST
DO INQUIRE(FILE)
QUIT
End DoDot:1
QUIT
+46 IF Y="TRANSFER"
DO ADD^FSCEVENT
QUIT
+47 IF Y="DELETE"
DO DEL^FSCEVENT
QUIT
+48 QUIT
+49 ;
NEW ;
+1 NEW DIR,END,START,X,Y
KILL DIR
+2 SET START=$EXTRACT(DT,1,3)-1_"0101"
SET END=$EXTRACT(DT,1,3)+1_"1201"
+3 SET DIR(0)="DAO^"_START_":"_END_":EX"
+4 SET DIR("?",1)="Enter the schedule date."
+5 SET DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
+6 SET DIR("??")="FSC U1 NOIS"
+7 SET DIR("A")="Select Date: "
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
QUIT
+10 IF '$LENGTH(Y)
QUIT
+11 SET X=Y
+12 NEW DIC,DO,Y
KILL DIC,DO,Y
+13 SET DIC="^FSCD(""SCHEDULE"","
SET DIC(0)="AEMQL"
SET DIC("DR")="1///^S X=DUZ;2:999"
+14 DO FILE^DICN
KILL DIC,Y
+15 QUIT
+16 ;
PRINT(FILE) ;
+1 NEW DIC,L
+2 IF FILE="SCHEDULES"
SET DIC="^FSCD(""SCHEDULE"","
+3 IF FILE="EVENTS"
SET DIC="^FSCD(""EVENTS"","
+4 IF FILE="RECURRING EVENTS"
SET DIC="^FSC(""REVENT"","
+5 SET L="LIST "_$PIECE(@(DIC_"0)"),U)
+6 DO EN1^DIP
+7 QUIT
+8 ;
SEARCH(FILE) ;
+1 NEW DIC
+2 IF FILE="SCHEDULES"
SET DIC="^FSCD(""SCHEDULE"","
+3 IF FILE="EVENTS"
SET DIC="^FSCD(""EVENTS"","
+4 IF FILE="RECURRING EVENTS"
SET DIC="^FSC(""REVENT"","
+5 DO EN^DIS
+6 QUIT
+7 ;
INQUIRE(FILE) ;
+1 NEW CONTINUE,DIC
KILL DIC
SET CONTINUE=1
+2 IF FILE="SCHEDULES"
SET DIC="^FSCD(""SCHEDULE"","
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,2)=DUZ!$$ACCESS^FSCU(DUZ,""SUPER"")"
+3 IF FILE="EVENTS"
SET DIC="^FSCD(""EVENTS"","
SET DIC(0)="AEMQ"
+4 IF FILE="RECURRING EVENTS"
SET DIC="^FSC(""REVENT"","
SET DIC(0)="AEMQ"
+5 IF DIC(0)'["L"
IF $$ACCESS^FSCU(DUZ,"SUPER")
SET DIC(0)=DIC(0)_"L"
+6 NEW ZERODIC
SET ZERODIC=DIC(0)
+7 FOR
Begin DoDot:1
+8 NEW ENTRY,EDIT,DR,OK
+9 SET DIC(0)=ZERODIC
+10 SET OK=1
WRITE !
DO ^DIC
IF Y<1
SET OK=0
+11 IF 'OK
SET CONTINUE=0
QUIT
+12 SET ENTRY=Y
SET EDIT=DIC
+13 DO SHOW(EDIT,+ENTRY,.OK)
+14 IF '$$ACCESS^FSCU(DUZ,"SUPER")
IF DIC["EVENT"
DO PAUSE^FSCU(.OK)
QUIT
+15 SET DR=".01:999"
+16 IF DIC["SCHEDULE"
IF '$$ACCESS^FSCU(DUZ,"SUPER")
SET DR=".01;2:999"
+17 DO EDIT(EDIT,+ENTRY,DR,.OK)
End DoDot:1
IF 'CONTINUE
QUIT
+18 QUIT
EDIT(EDIT,DA,DR,OK) ;
+1 NEW DIE,GBL
SET OK=1
+2 DO FILE(EDIT,DA,.DIE,.GBL,.OK)
+3 IF 'OK
QUIT
+4 LOCK +@GBL:30
IF '$TEST
WRITE !,"Unable to edit."
QUIT
+5 DO ^DIE
+6 LOCK -@GBL
+7 QUIT
+8 ;
FILE(DIC,ENTRY,DIE,GBL,OK) ;
+1 SET OK=0
+2 IF '$DATA(@(DIC_"0)"))
QUIT
+3 SET DIE=DIC
SET GBL=DIE_ENTRY_")"
SET OK=1
+4 QUIT
+5 ;
SHOW(DIC,DA,OK) ;
+1 SET OK=0
+2 IF '$DATA(@(DIC_"0)"))
QUIT
+3 DO EN^DIQ
SET OK=1
+4 QUIT
