EEOUTIL1 ;HISC/JWR - COMPLAINT STATUS & TYPE COMPUTATIONS ;Apr 20, 1995
;;2.0;EEO Complaint Tracking;;Apr 27, 1995
STATUS ;COMPUTATON TO DETERMINE COMPLAINT STATUS
S (CLO,FAD,INP,ADV,HEA)=""
F CN=1,2,3,4,5,12 S EEO1(CN)=$G(^EEO(785,D0,CN))
S ACP=$P(EEO1(1),U,3),ACR=$P(EEO1(2),U,2),DTO=$P(EEO1(12),U)
S:$P(EEO1(2),U,4)>0!($P(EEO1(2),U,3)>0)!($P(EEO1(2),U,5)>0) INP=1
S INV=$P(EEO1(3),U,6) S:$P(EEO1(2),U,6)>0!($P(EEO1(5),U,10)>0) ADV=1
S:$P(EEO1(2),U,9)>0!($P(EEO1(2),U,10)>0) HEA=1
S:$P(EEO1(2),U,13)>0 FAD=1 S DEL=$P(EEO1(12),U,2)
S:$P(EEO1(4),U)>0 CLO=1
S X=$S(DEL'="":"DELETED",CLO'="":"CLOSED",FAD'="":"FAD PND",HEA'="":"HEARING PND",ADV'="":"ADVISED/RIGHTS",INV'="":"INVESTIGATION",INP'="":"INV PND",DTO'="":"OGC DISMISSED",ACR'="":"ACC REV @ OGC",ACP'="":"ACC PND FIELD",1:"INFORMAL")
I ACP'>0 S X="INFORMAL"
Q
TYPE ;COMPUTATION TO DETERMINE TYPE OF INVESTIGATOR
S (EEOTYPE,EEODATE)="" Q:X="" N AEE S EEOTMP=$P($G(^EEO(785,D0,11,DA,0)),U)
Q:EEOTMP=""
Q:'$D(^EEO(787.5,EEOTMP,1)) S EEOCN=0 F S EEOCN=$O(^EEO(787.5,EEOTMP,1,EEOCN)) Q:EEOCN'=+EEOCN S AEE=$G(^(EEOCN,0)) D
.I $P(AEE,U,2)<X&(($P(AEE,U,3)>X)!($P(AEE,U,3)="")) I EEODATE'>$P(AEE,U,2) S EEOTYPE=$P(AEE,U),EEODATE=$P(AEE,U,3)
S EEOTYPE=$S(EEOTYPE=1:"ADHOC",EEOTYPE=2:"RETIRED ANNUITANT",EEOTYPE=3:"REGIONAL SPECIALIST",1:"")
K EEODATE,EEOCN,EEOTMP Q
INACT ;DETERMINES IF THE INVESTIGATOR SELECTED IS CURRENTLY ACTIVE
Q:$D(XMZ)!($G(X)'>0) I $D(^EEO(787.5,X)) S FLAG=+$G(^(X,3))
Q:FLAG'>0
S DIR(0)="YAO",DIR("A")=" Are you sure, VACO lists this investigator as inactive ",DIR("B")="NO"
S DIR("?")="Inactive status is assigned by VACO to investigators who are not currently investigating EEO Complaints."
S EEOX1=X W ! D ^DIR K:Y=0 X S:Y>0 X=EEOX1 K DIR,FLAG Q
ACCEPT ;Calculates the days acceptance field
F CNT1=2,4,5,12 S @("EEOI"_CNT1)=$S($D(^EEO(785,D0)):$G(^(D0,CNT1)),1:"")
S EEOBEG=$P(EEOI5,U,9),EEOTOGC=$P(EEOI2,U,2),EEODAS=$P(EEOI2,U,4)
S EEODIR=$P(EEOI2,U,5),EEOAO=$S($P(EEOI2,U,3)>0:$P(EEOI2,U,3),1:+EEOI12)
S EEOCLO=+EEOI4,EEOFAD=$P(EEOI2,U,13)
I EEOBEG'>0 S X="" Q
S (EEOX11,X1)=$S(EEODAS:EEODAS,EEODIR:EEODIR,EEOFAD:EEOFAD,EEOCLO:EEOCLO,1:DT)
S X2=EEOBEG D ^%DTC S EEOAC1=X
S X2=EEOTOGC,(EEOX2,X1)=$S(EEOAO:EEOAO,+EEOI12:+EEOI12,EEODAS:EEODAS,EEODIR:EEODIR,EEOFAD:EEOFAD,EEOCLO:EEOCLO,1:DT) D ^%DTC S EEOAC2=X
S X=EEOAC1-EEOAC2 S:EEOAC1'>EEOAC2 X="" S:EEOX11=DT&(X>0)&(EEOX2=DT) X=X_"*"
K EEOBEG,EEOCLO,EEODAS,EEODIR,EEOFAD,EEOTOGC,EEOI2,EEOI4,EEOI5,EEOI12,EEOX1,EEOX2,EEOX11,EEOAC1,EEOAC2,EEOAO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOUTIL1 2550 printed Apr 09, 2024@20:56:14 Page 2
EEOUTIL1 ;HISC/JWR - COMPLAINT STATUS & TYPE COMPUTATIONS ;Apr 20, 1995
+1 ;;2.0;EEO Complaint Tracking;;Apr 27, 1995
STATUS ;COMPUTATON TO DETERMINE COMPLAINT STATUS
+1 SET (CLO,FAD,INP,ADV,HEA)=""
+2 FOR CN=1,2,3,4,5,12
SET EEO1(CN)=$GET(^EEO(785,D0,CN))
+3 SET ACP=$PIECE(EEO1(1),U,3)
SET ACR=$PIECE(EEO1(2),U,2)
SET DTO=$PIECE(EEO1(12),U)
+4 if $PIECE(EEO1(2),U,4)>0!($PIECE(EEO1(2),U,3)>0)!($PIECE(EEO1(2),U,5)>0)
SET INP=1
+5 SET INV=$PIECE(EEO1(3),U,6)
if $PIECE(EEO1(2),U,6)>0!($PIECE(EEO1(5),U,10)>0)
SET ADV=1
+6 if $PIECE(EEO1(2),U,9)>0!($PIECE(EEO1(2),U,10)>0)
SET HEA=1
+7 if $PIECE(EEO1(2),U,13)>0
SET FAD=1
SET DEL=$PIECE(EEO1(12),U,2)
+8 if $PIECE(EEO1(4),U)>0
SET CLO=1
+9 SET X=$SELECT(DEL'="":"DELETED",CLO'="":"CLOSED",FAD'="":"FAD PND",HEA'="":"HEARING PND",ADV'="":"ADVISED/RIGHTS",INV'="":"INVESTIGATION",INP'="":"INV PND",DTO'="":"OGC DISMISSED",ACR'="":"ACC REV @ OGC",ACP'="":"ACC PND FIELD",1:"INFORMAL")
+10 IF ACP'>0
SET X="INFORMAL"
+11 QUIT
TYPE ;COMPUTATION TO DETERMINE TYPE OF INVESTIGATOR
+1 SET (EEOTYPE,EEODATE)=""
if X=""
QUIT
NEW AEE
SET EEOTMP=$PIECE($GET(^EEO(785,D0,11,DA,0)),U)
+2 if EEOTMP=""
QUIT
+3 if '$DATA(^EEO(787.5,EEOTMP,1))
QUIT
SET EEOCN=0
FOR
SET EEOCN=$ORDER(^EEO(787.5,EEOTMP,1,EEOCN))
if EEOCN'=+EEOCN
QUIT
SET AEE=$GET(^(EEOCN,0))
Begin DoDot:1
+4 IF $PIECE(AEE,U,2)<X&(($PIECE(AEE,U,3)>X)!($PIECE(AEE,U,3)=""))
IF EEODATE'>$PIECE(AEE,U,2)
SET EEOTYPE=$PIECE(AEE,U)
SET EEODATE=$PIECE(AEE,U,3)
End DoDot:1
+5 SET EEOTYPE=$SELECT(EEOTYPE=1:"ADHOC",EEOTYPE=2:"RETIRED ANNUITANT",EEOTYPE=3:"REGIONAL SPECIALIST",1:"")
+6 KILL EEODATE,EEOCN,EEOTMP
QUIT
INACT ;DETERMINES IF THE INVESTIGATOR SELECTED IS CURRENTLY ACTIVE
+1 if $DATA(XMZ)!($GET(X)'>0)
QUIT
IF $DATA(^EEO(787.5,X))
SET FLAG=+$GET(^(X,3))
+2 if FLAG'>0
QUIT
+3 SET DIR(0)="YAO"
SET DIR("A")=" Are you sure, VACO lists this investigator as inactive "
SET DIR("B")="NO"
+4 SET DIR("?")="Inactive status is assigned by VACO to investigators who are not currently investigating EEO Complaints."
+5 SET EEOX1=X
WRITE !
DO ^DIR
if Y=0
KILL X
if Y>0
SET X=EEOX1
KILL DIR,FLAG
QUIT
ACCEPT ;Calculates the days acceptance field
+1 FOR CNT1=2,4,5,12
SET @("EEOI"_CNT1)=$SELECT($DATA(^EEO(785,D0)):$GET(^(D0,CNT1)),1:"")
+2 SET EEOBEG=$PIECE(EEOI5,U,9)
SET EEOTOGC=$PIECE(EEOI2,U,2)
SET EEODAS=$PIECE(EEOI2,U,4)
+3 SET EEODIR=$PIECE(EEOI2,U,5)
SET EEOAO=$SELECT($PIECE(EEOI2,U,3)>0:$PIECE(EEOI2,U,3),1:+EEOI12)
+4 SET EEOCLO=+EEOI4
SET EEOFAD=$PIECE(EEOI2,U,13)
+5 IF EEOBEG'>0
SET X=""
QUIT
+6 SET (EEOX11,X1)=$SELECT(EEODAS:EEODAS,EEODIR:EEODIR,EEOFAD:EEOFAD,EEOCLO:EEOCLO,1:DT)
+7 SET X2=EEOBEG
DO ^%DTC
SET EEOAC1=X
+8 SET X2=EEOTOGC
SET (EEOX2,X1)=$SELECT(EEOAO:EEOAO,+EEOI12:+EEOI12,EEODAS:EEODAS,EEODIR:EEODIR,EEOFAD:EEOFAD,EEOCLO:EEOCLO,1:DT)
DO ^%DTC
SET EEOAC2=X
+9 SET X=EEOAC1-EEOAC2
if EEOAC1'>EEOAC2
SET X=""
if EEOX11=DT&(X>0)&(EEOX2=DT)
SET X=X_"*"
+10 KILL EEOBEG,EEOCLO,EEODAS,EEODIR,EEOFAD,EEOTOGC,EEOI2,EEOI4,EEOI5,EEOI12,EEOX1,EEOX2,EEOX11,EEOAC1,EEOAC2,EEOAO
