- 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 Feb 18, 2025@23:46:52 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