- EEOEOE1 ;HISC/CFB/CJM - CLOSE/DELETE;8/20/96
- ;;2.0;EEO Complaint Tracking;**10**;AUG-20-96
- ;
- CLOSE ;Close a case
- S (DIC("A"),EEOYQ)="Close case."
- S (DIC,DIE)="^EEO(785,",DIC(0)="AEQMZ"
- S (EEOYSCR,DIC("S"))="I $$SCREEN^EEOEOSE(Y) I $P($G(^EEO(785,Y,1)),U,3)>0!(+$G(^EEO(785,Y,""SEC""))'>0)"
- S (EEOYDICA,DIC("A"))="Select Complainant: "
- S DR="48;49" D CALL("CLOSE") G:$G(DA)>0 CLOSE
- Q
- ;
- UNDELETE K DR
- UND S DIC("S")="I $P($G(^EEO(785,+Y,12)),U,2)'=""""" S DIC="^EEO(785,"
- S DIC(0)="AEMQZ",DIC("A")=" Select Complainant to be Undeleted: "
- S:$G(DR)["48.5" DIC("A")="Another: "
- S DR="48.5///@",DIE=785 D CALL("UNDELETE") I $G(DA)>0 S $P(^XTMP("EEOX",DA,12),U,2)="@" W !!," Undeleted!!",!! G UND
- K Y,DIE,DR,DA,DIC Q
- ;
- DELETE ;Delete a specific EEO case
- W !!,"** Deleting a complaint does not actually cause its deletion, but does",!,"prevent it from being viewed. It can be undeleted later if necessary. **",!
- S (DIC("A"),EEOYQ)="Delete a specific EEO case."
- S (DIC,DIE)="^EEO(785,",DIC(0)="AEQMZ"
- S (EEOYDICA,DIC("A"))="Select Complainant: "
- S (EEOYSCR,DIC("S"))="I $$SCREEN^EEOEOSE(Y) I $P($G(^EEO(785,Y,1)),U,3)>0!(+$G(^EEO(785,Y,""SEC""))'>0)"
- S DR="48.5///D" D CALL("DELETE") I $G(DA)>0 W !!," Deleted!!",!! G DELETE
- Q
- REOP ;
- S EEOYQ="Reopen a previously closed case "
- S (DIC,DIE)="^EEO(785,",DIC(0)="AEQMZ"
- S (EEOYSCR,DIC("S"))="I $$SCREEN^EEOEOSE(Y) I $G(^EEO(785,Y,4))'="""" I $G(^(4))'=""^"""
- S (EEODICA,DIC("A"))="Select Complainant: "
- S DR="48///@;49///@" D CALL("REOPEN") I $G(DA)>0 S ^XTMP("EEOX",DA,4)="@^@" G REOP
- Q
- CALL(ACTION) ;
- K DA D ^DIC Q:X="^"!("")!($D(DTOUT))
- S EOY=+Y
- Q:+Y'>0
- I (ACTION'="CLOSE")!($G(^EEO(785,+Y,4))="^")!($G(^EEO(785,+Y,4))="") I '$$RUSURE(ACTION) S DA=0 Q
- S DA=+Y,DR=DR_";62///X"
- D ^DIE
- D CASENO^EEOEOSE
- S ^XTMP("EEOX",0)=DT+5_"^"_DT
- Q
- ;
- RUSURE(ACTION) ;asks user for confirmation if ACTION should be taken, returns 0 or 1
- ;
- N ANS
- ASK W !!,"Are you sure you want to "_ACTION_" this complaint YES/"
- S ANS=""
- R ANS:30
- I '$T Q 0
- I ANS="" Q 1
- I ANS["?" W !!,"Enter YES or NO" G ASK
- I ANS["^" Q 0
- I "Yy"[$E(ANS,1) Q 1
- I "Nn"[$E(ANS,1) Q 0
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOEOE1 2189 printed Mar 13, 2025@20:55:41 Page 2
- EEOEOE1 ;HISC/CFB/CJM - CLOSE/DELETE;8/20/96
- +1 ;;2.0;EEO Complaint Tracking;**10**;AUG-20-96
- +2 ;
- CLOSE ;Close a case
- +1 SET (DIC("A"),EEOYQ)="Close case."
- +2 SET (DIC,DIE)="^EEO(785,"
- SET DIC(0)="AEQMZ"
- +3 SET (EEOYSCR,DIC("S"))="I $$SCREEN^EEOEOSE(Y) I $P($G(^EEO(785,Y,1)),U,3)>0!(+$G(^EEO(785,Y,""SEC""))'>0)"
- +4 SET (EEOYDICA,DIC("A"))="Select Complainant: "
- +5 SET DR="48;49"
- DO CALL("CLOSE")
- if $GET(DA)>0
- GOTO CLOSE
- +6 QUIT
- +7 ;
- UNDELETE KILL DR
- UND SET DIC("S")="I $P($G(^EEO(785,+Y,12)),U,2)'="""""
- SET DIC="^EEO(785,"
- +1 SET DIC(0)="AEMQZ"
- SET DIC("A")=" Select Complainant to be Undeleted: "
- +2 if $GET(DR)["48.5"
- SET DIC("A")="Another: "
- +3 SET DR="48.5///@"
- SET DIE=785
- DO CALL("UNDELETE")
- IF $GET(DA)>0
- SET $PIECE(^XTMP("EEOX",DA,12),U,2)="@"
- WRITE !!," Undeleted!!",!!
- GOTO UND
- +4 KILL Y,DIE,DR,DA,DIC
- QUIT
- +5 ;
- DELETE ;Delete a specific EEO case
- +1 WRITE !!,"** Deleting a complaint does not actually cause its deletion, but does",!,"prevent it from being viewed. It can be undeleted later if necessary. **",!
- +2 SET (DIC("A"),EEOYQ)="Delete a specific EEO case."
- +3 SET (DIC,DIE)="^EEO(785,"
- SET DIC(0)="AEQMZ"
- +4 SET (EEOYDICA,DIC("A"))="Select Complainant: "
- +5 SET (EEOYSCR,DIC("S"))="I $$SCREEN^EEOEOSE(Y) I $P($G(^EEO(785,Y,1)),U,3)>0!(+$G(^EEO(785,Y,""SEC""))'>0)"
- +6 SET DR="48.5///D"
- DO CALL("DELETE")
- IF $GET(DA)>0
- WRITE !!," Deleted!!",!!
- GOTO DELETE
- +7 QUIT
- REOP ;
- +1 SET EEOYQ="Reopen a previously closed case "
- +2 SET (DIC,DIE)="^EEO(785,"
- SET DIC(0)="AEQMZ"
- +3 SET (EEOYSCR,DIC("S"))="I $$SCREEN^EEOEOSE(Y) I $G(^EEO(785,Y,4))'="""" I $G(^(4))'=""^"""
- +4 SET (EEODICA,DIC("A"))="Select Complainant: "
- +5 SET DR="48///@;49///@"
- DO CALL("REOPEN")
- IF $GET(DA)>0
- SET ^XTMP("EEOX",DA,4)="@^@"
- GOTO REOP
- +6 QUIT
- CALL(ACTION) ;
- +1 KILL DA
- DO ^DIC
- if X="^"!("")!($DATA(DTOUT))
- QUIT
- +2 SET EOY=+Y
- +3 if +Y'>0
- QUIT
- +4 IF (ACTION'="CLOSE")!($GET(^EEO(785,+Y,4))="^")!($GET(^EEO(785,+Y,4))="")
- IF '$$RUSURE(ACTION)
- SET DA=0
- QUIT
- +5 SET DA=+Y
- SET DR=DR_";62///X"
- +6 DO ^DIE
- +7 DO CASENO^EEOEOSE
- +8 SET ^XTMP("EEOX",0)=DT+5_"^"_DT
- +9 QUIT
- +10 ;
- RUSURE(ACTION) ;asks user for confirmation if ACTION should be taken, returns 0 or 1
- +1 ;
- +2 NEW ANS
- ASK WRITE !!,"Are you sure you want to "_ACTION_" this complaint YES/"
- +1 SET ANS=""
- +2 READ ANS:30
- +3 IF '$TEST
- QUIT 0
- +4 IF ANS=""
- QUIT 1
- +5 IF ANS["?"
- WRITE !!,"Enter YES or NO"
- GOTO ASK
- +6 IF ANS["^"
- QUIT 0
- +7 IF "Yy"[$EXTRACT(ANS,1)
- QUIT 1
- +8 IF "Nn"[$EXTRACT(ANS,1)
- QUIT 0
- +9 QUIT 0
