EEO211 ;HISC/JWR - GATHERS INFORMATION FOR FORM 0210 (COUNS. INTAKE FORM) ;Apr 20, 1995
;;2.0;EEO Complaint Tracking;**1,2**;Apr 27, 1995
GATHER ;Gathers complaint information for the Complaint Intake Form (0210)
S EEOFIL=785,EEOSJ=$J K ^TMP("EEOJ",EEOSJ)
K EEO1 F NO=0,1,5,6 S EEO1(NO)=$G(^EEO(EEOFIL,DA,NO))
S EEONA=$P(EEO1(0),U),EEOSE=$P(EEO1(0),U,4),EEOPO=$P(EEO1(0),U,5)
S EEORE=$P(EEO1(0),U,7),EEOPH=$P(EEO1(0),U,8),EEOSTR=$P(EEO1(0),U,9)
S EEOCI=$P(EEO1(0),U,10),EEOST=$P(EEO1(0),U,11),EEOZI=$P(EEO1(0),U,12)
S EEOIN=$P(EEO1(1),U,12),EEOFI=$P(EEO1(1),U,2),EEOCO=$P(EEO1(1),U)
S EEOUN=$P(EEO1(6),U),EEOMS=$P(EEO1(6),U,2),EEOJO=$P(EEO1(5),U,19)
I EEOST>0 I '$D(^DIC(5,EEOST)) S EEOST=" "
E S:EEOST>0 EEOST=$P(^DIC(5,EEOST,0),U,2)
I EEOSE>0 I '$D(^ECC(730,EEOSE)) S EEOSE=" "
E S:EEOSE>0 EEOSE=$P(^ECC(730,EEOSE,0),U)
S:EEOCI'="" EEOCI=EEOCI_"," S EEOVA=""
S:+$G(^EEO(785,DA,1))>0 EEOVA=$G(^VA(200,+$P(^(1),U),20))
S EEONAME=$P(EEOVA,U,2),EEOTITL=$E($P(EEOVA,U,3),1,40),EEOCAS=$P(EEO1(5),U,6)
S Y=EEOIN D DT S EEOIN=Y,Y=EEOFI D DT S EEOFI=Y D NOW^%DTC S EEOCT=%H,Y=DT D DT S EEODT=Y S EEOCT=($E(EEOCT,11)_$E(EEOCT,5)_$E(EEOCT,7,10))
MULT ;Makes an array of the information in the multiple field
S EEOFIL=$S($D(^EEO(785.5,DA)):785.5,1:785)
F CNT=8,9,10 S CN=0,EEO1(CNT)="^" F S CN=$O(^EEO(EEOFIL,DA,CNT,CN)) Q:CN=""!(+CN'=CN) S EEO1(CNT)=EEO1(CNT)_^(CN,0)_"^"
WP S EEOFIL=$S($D(^EEO(785.5,DA)):785.5,1:785)
S CNT=7,CN=0 F S CN=$O(^EEO(EEOFIL,DA,CNT,CN)) Q:CN=""!(+CN'=CN) D
.S ^TMP("EEOJ",EEOSJ,CNT,CN)=$G(^EEO(EEOFIL,DA,CNT,CN,0))
Q
BOX ;Fills boxes for Issue Codes on Form 0210
S EN="",EOC=0,EEO2J=EEO1J F ECN=1:1:60 S CX=$P(EEO1(10),U,ECN) I CX<50&(CX>0) I $D(^EEO(786,CX)) S EOE2=" ",EN=$P(^EEO(786,CX,0),U),CN=$E(EN,1,21) D
.S Y=$P($P(EEO1(10),U,ECN+1),U) D DD^%DT S EOE2=Y,BOX="[X]",EOC=EOC+1
.I $P(EEO1(10),U,ECN+1)'>2000000 S EOE2=""
.I BOX="[X]" I EOC#2=1 W !,OE,BOX,CN,$J(OE,80-$L(CN)-58),EOE2,$J(" ||",15-$L(EOE2)) S EEO1J=EEO1J+1
.I BOX="[X]" I EOC#2=0 W BOX,CN,$J(OE,22-$L(CN)),EOE2,$J(OE,14-$L(EOE2))
.X EEOIOF Q:EEOQUIT=1 K EOE2
I EOC#2=1 W $J(OE,25),$J(OE,14)
I EEO1J=EEO2J W !,OE,$J(OE,25),$J("||",15),$J(OE,25),$J(OE,14) S EEO1J=EEO1J+1
Q
DT D DD^%DT Q
BOXB ;Fills basis boxes on Form 0210
S EEO1J=0,CN="",EOC=0 F S CN=$O(^EEO(785.1,"B",CN)) Q:CN="" S BOX="[ ]" D
.S CX=$O(^EEO(785.1,"B",CN,"")) I EEO1(9)[("^"_CX_"^") S BOX="[X]",EOC=EOC+1
.I BOX="[X]" I EOC#2=1 W !,OE,BOX," ",CN,$J(OE,36-$L(CN)) S EEO1J=EEO1J+1
.I BOX="[X]" I EOC#2=0 W BOX," ",CN,$J(OE,35-$L(CN))
.X EEOIOF Q:EEOQUIT=1
I EOC#2=1 W $J(OE,39)
I EEO1J=0 W !,OE,$J(OE,40),$J(OE,39) S EEO1J=1
Q
BOXC ;
BOXC1 ;Fills boxes for Corrective actions on Form 0210
S EEO2J=EEO1J F CN=2:1 Q:$P(EEO1(8),U,CN)'>0 D
.Q:'$D(^EEO(785.2,$P(EEO1(8),U,CN)))
.S EOE=$P(^EEO(785.2,$P(EEO1(8),U,CN),0),U) W !,OE," ",EOE,$J(OE,78-$L(EOE)) S EEO1J=EEO1J+1 X EEOIOF Q:EEOQUIT=1
.I EEO1J=EEO2J W !,OE,$J(OE,79),!,OE,$J(OE,79) S EEO1J=EEO1J+2
Q
WPB ;Checks legnth of word processing fields
Q:EEOQUIT=1
S EEOH=15-EEO1J,CN=1 S:IOSL>60 EEOH=EEOH+IOSL-60 W !,OE,$J(OE,79)
WPB2 ;Enter here if WP field requires more than one page
S EEOD=0 F CN=CN:1 Q:'$D(^TMP("EEOJ",EEOSJ,7,CN)) D:$L(^(CN))>78 TEST X EEOIOF Q:EEOQUIT=1 Q:EEOH-2'>EEOD I $L(^(CN))'>78 W !,OE,^(CN),$J(OE,79-$L(^(CN))) S EEOD=EEOD+1 I EEOH-2'>EEOD I $D(^(CN+1)) Q
S EEO("WP")="" D:$D(^TMP("EEOJ",EEOSJ,7,CN+1)) WPB3
I '$D(^TMP("EEOJ",EEOSJ,7,CN+1)) D FILL
Q
LEND ;If information for Form 0210 is more than one page this makes second page
Q:EEO("WP")'=1 S EEO1J=0,EEOH=44
S:IOSL>60 EEOH=EEOH+IOSL-60 W:IOS'=EEOII @IOF W:$D(IO("S")) ! D HEAD^EEO0210 Q:EEOQUIT=1
W " 17. Case number",$J(OE,29),!,OE," ",EEONA,$J(OE,40-$L(EEONA)-11)," ",EEOCAS,$J(OE,45-$L(EEOCAS)-5),!,OE,EO,OE
W !,OE,"10.Recommended Information Gathering (list names, documents, and records) |",!,OE,$J(OE,79) S CN=CN+1 D WPB2 Q:EEOQUIT=1
D FOOT^EEO0210 I $D(^TMP("EEOJ",EEOSJ,7,CN)) G LEND
EX1 K EEONAME,EEOTITL,EEOVA,^TMP("EEOJ",EEOSJ),EEOSJ
Q
TEST ;Test legnth of word processing fields
Q:'$D(^TMP("EEOJ",EEOSJ,7,CN)) Q:$L(^TMP("EEOJ",EEOSJ,7,CN))<79 F CT=1:1 Q:CT-1*78>$L(^TMP("EEOJ",EEOSJ,7,CN)) S EEO=78*(CT-1) D
.S EEOD=EEOD+1
.S ^TMP("EEOJ",EEOSJ,7,CN,CT)=$E(^TMP("EEOJ",EEOSJ,7,CN),EEO+1,EEO+78)
.X EEOIOF Q:EEOQUIT=1
.W !,OE,^TMP("EEOJ",EEOSJ,7,CN,CT),$J(OE,79-$L(^TMP("EEOJ",EEOSJ,7,CN,CT)))
Q
WPB3 ;If more than one page is required for Form 0210
X EEOIOF Q:EEOQUIT=1
W !,OE,$J(OE,79),!,OE,$J(OE,79),!,OE,$J("(Recommended Info. Gathering Displayed on Following Page)",67),$J(OE,12) S EEO("WP")=1
Q
FILL ;Fills in blank lines
F CN2=EEOD:1:EEOH X EEOIOF Q:EEOQUIT=1 W !,OE,$J(OE,79)
S EEOD=0 Q
TERMIOF ;
I $Y'>(IOSL-6) Q
I IOS=EEOII I $G(EEOQ)'>0 I '$D(IO("S")) D
.W ! S DIR(0)="FAO^0:1^",DIR("A")=" Hit return to continue or ""^"" to exit "
.D ^DIR S:X="^" EEOQUIT=1
.W @IOF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEO211 4974 printed Dec 13, 2024@01:50:49 Page 2
EEO211 ;HISC/JWR - GATHERS INFORMATION FOR FORM 0210 (COUNS. INTAKE FORM) ;Apr 20, 1995
+1 ;;2.0;EEO Complaint Tracking;**1,2**;Apr 27, 1995
GATHER ;Gathers complaint information for the Complaint Intake Form (0210)
+1 SET EEOFIL=785
SET EEOSJ=$JOB
KILL ^TMP("EEOJ",EEOSJ)
+2 KILL EEO1
FOR NO=0,1,5,6
SET EEO1(NO)=$GET(^EEO(EEOFIL,DA,NO))
+3 SET EEONA=$PIECE(EEO1(0),U)
SET EEOSE=$PIECE(EEO1(0),U,4)
SET EEOPO=$PIECE(EEO1(0),U,5)
+4 SET EEORE=$PIECE(EEO1(0),U,7)
SET EEOPH=$PIECE(EEO1(0),U,8)
SET EEOSTR=$PIECE(EEO1(0),U,9)
+5 SET EEOCI=$PIECE(EEO1(0),U,10)
SET EEOST=$PIECE(EEO1(0),U,11)
SET EEOZI=$PIECE(EEO1(0),U,12)
+6 SET EEOIN=$PIECE(EEO1(1),U,12)
SET EEOFI=$PIECE(EEO1(1),U,2)
SET EEOCO=$PIECE(EEO1(1),U)
+7 SET EEOUN=$PIECE(EEO1(6),U)
SET EEOMS=$PIECE(EEO1(6),U,2)
SET EEOJO=$PIECE(EEO1(5),U,19)
+8 IF EEOST>0
IF '$DATA(^DIC(5,EEOST))
SET EEOST=" "
+9 IF '$TEST
if EEOST>0
SET EEOST=$PIECE(^DIC(5,EEOST,0),U,2)
+10 IF EEOSE>0
IF '$DATA(^ECC(730,EEOSE))
SET EEOSE=" "
+11 IF '$TEST
if EEOSE>0
SET EEOSE=$PIECE(^ECC(730,EEOSE,0),U)
+12 if EEOCI'=""
SET EEOCI=EEOCI_","
SET EEOVA=""
+13 if +$GET(^EEO(785,DA,1))>0
SET EEOVA=$GET(^VA(200,+$PIECE(^(1),U),20))
+14 SET EEONAME=$PIECE(EEOVA,U,2)
SET EEOTITL=$EXTRACT($PIECE(EEOVA,U,3),1,40)
SET EEOCAS=$PIECE(EEO1(5),U,6)
+15 SET Y=EEOIN
DO DT
SET EEOIN=Y
SET Y=EEOFI
DO DT
SET EEOFI=Y
DO NOW^%DTC
SET EEOCT=%H
SET Y=DT
DO DT
SET EEODT=Y
SET EEOCT=($EXTRACT(EEOCT,11)_$EXTRACT(EEOCT,5)_$EXTRACT(EEOCT,7,10))
MULT ;Makes an array of the information in the multiple field
+1 SET EEOFIL=$SELECT($DATA(^EEO(785.5,DA)):785.5,1:785)
+2 FOR CNT=8,9,10
SET CN=0
SET EEO1(CNT)="^"
FOR
SET CN=$ORDER(^EEO(EEOFIL,DA,CNT,CN))
if CN=""!(+CN'=CN)
QUIT
SET EEO1(CNT)=EEO1(CNT)_^(CN,0)_"^"
WP SET EEOFIL=$SELECT($DATA(^EEO(785.5,DA)):785.5,1:785)
+1 SET CNT=7
SET CN=0
FOR
SET CN=$ORDER(^EEO(EEOFIL,DA,CNT,CN))
if CN=""!(+CN'=CN)
QUIT
Begin DoDot:1
+2 SET ^TMP("EEOJ",EEOSJ,CNT,CN)=$GET(^EEO(EEOFIL,DA,CNT,CN,0))
End DoDot:1
+3 QUIT
BOX ;Fills boxes for Issue Codes on Form 0210
+1 SET EN=""
SET EOC=0
SET EEO2J=EEO1J
FOR ECN=1:1:60
SET CX=$PIECE(EEO1(10),U,ECN)
IF CX<50&(CX>0)
IF $DATA(^EEO(786,CX))
SET EOE2=" "
SET EN=$PIECE(^EEO(786,CX,0),U)
SET CN=$EXTRACT(EN,1,21)
Begin DoDot:1
+2 SET Y=$PIECE($PIECE(EEO1(10),U,ECN+1),U)
DO DD^%DT
SET EOE2=Y
SET BOX="[X]"
SET EOC=EOC+1
+3 IF $PIECE(EEO1(10),U,ECN+1)'>2000000
SET EOE2=""
+4 IF BOX="[X]"
IF EOC#2=1
WRITE !,OE,BOX,CN,$JUSTIFY(OE,80-$LENGTH(CN)-58),EOE2,$JUSTIFY(" ||",15-$LENGTH(EOE2))
SET EEO1J=EEO1J+1
+5 IF BOX="[X]"
IF EOC#2=0
WRITE BOX,CN,$JUSTIFY(OE,22-$LENGTH(CN)),EOE2,$JUSTIFY(OE,14-$LENGTH(EOE2))
+6 XECUTE EEOIOF
if EEOQUIT=1
QUIT
KILL EOE2
End DoDot:1
+7 IF EOC#2=1
WRITE $JUSTIFY(OE,25),$JUSTIFY(OE,14)
+8 IF EEO1J=EEO2J
WRITE !,OE,$JUSTIFY(OE,25),$JUSTIFY("||",15),$JUSTIFY(OE,25),$JUSTIFY(OE,14)
SET EEO1J=EEO1J+1
+9 QUIT
DT DO DD^%DT
QUIT
BOXB ;Fills basis boxes on Form 0210
+1 SET EEO1J=0
SET CN=""
SET EOC=0
FOR
SET CN=$ORDER(^EEO(785.1,"B",CN))
if CN=""
QUIT
SET BOX="[ ]"
Begin DoDot:1
+2 SET CX=$ORDER(^EEO(785.1,"B",CN,""))
IF EEO1(9)[("^"_CX_"^")
SET BOX="[X]"
SET EOC=EOC+1
+3 IF BOX="[X]"
IF EOC#2=1
WRITE !,OE,BOX," ",CN,$JUSTIFY(OE,36-$LENGTH(CN))
SET EEO1J=EEO1J+1
+4 IF BOX="[X]"
IF EOC#2=0
WRITE BOX," ",CN,$JUSTIFY(OE,35-$LENGTH(CN))
+5 XECUTE EEOIOF
if EEOQUIT=1
QUIT
End DoDot:1
+6 IF EOC#2=1
WRITE $JUSTIFY(OE,39)
+7 IF EEO1J=0
WRITE !,OE,$JUSTIFY(OE,40),$JUSTIFY(OE,39)
SET EEO1J=1
+8 QUIT
BOXC ;
BOXC1 ;Fills boxes for Corrective actions on Form 0210
+1 SET EEO2J=EEO1J
FOR CN=2:1
if $PIECE(EEO1(8),U,CN)'>0
QUIT
Begin DoDot:1
+2 if '$DATA(^EEO(785.2,$PIECE(EEO1(8),U,CN)))
QUIT
+3 SET EOE=$PIECE(^EEO(785.2,$PIECE(EEO1(8),U,CN),0),U)
WRITE !,OE," ",EOE,$JUSTIFY(OE,78-$LENGTH(EOE))
SET EEO1J=EEO1J+1
XECUTE EEOIOF
if EEOQUIT=1
QUIT
+4 IF EEO1J=EEO2J
WRITE !,OE,$JUSTIFY(OE,79),!,OE,$JUSTIFY(OE,79)
SET EEO1J=EEO1J+2
End DoDot:1
+5 QUIT
WPB ;Checks legnth of word processing fields
+1 if EEOQUIT=1
QUIT
+2 SET EEOH=15-EEO1J
SET CN=1
if IOSL>60
SET EEOH=EEOH+IOSL-60
WRITE !,OE,$JUSTIFY(OE,79)
WPB2 ;Enter here if WP field requires more than one page
+1 SET EEOD=0
FOR CN=CN:1
if '$DATA(^TMP("EEOJ",EEOSJ,7,CN))
QUIT
if $LENGTH(^(CN))>78
DO TEST
XECUTE EEOIOF
if EEOQUIT=1
QUIT
if EEOH-2'>EEOD
QUIT
IF $LENGTH(^(CN))'>78
WRITE !,OE,^(CN),$JUSTIFY(OE,79-$LENGTH(^(CN)))
SET EEOD=EEOD+1
IF EEOH-2'>EEOD
IF $DATA(^(CN+1))
QUIT
+2 SET EEO("WP")=""
if $DATA(^TMP("EEOJ",EEOSJ,7,CN+1))
DO WPB3
+3 IF '$DATA(^TMP("EEOJ",EEOSJ,7,CN+1))
DO FILL
+4 QUIT
LEND ;If information for Form 0210 is more than one page this makes second page
+1 if EEO("WP")'=1
QUIT
SET EEO1J=0
SET EEOH=44
+2 if IOSL>60
SET EEOH=EEOH+IOSL-60
if IOS'=EEOII
WRITE @IOF
if $DATA(IO("S"))
WRITE !
DO HEAD^EEO0210
if EEOQUIT=1
QUIT
+3 WRITE " 17. Case number",$JUSTIFY(OE,29),!,OE," ",EEONA,$JUSTIFY(OE,40-$LENGTH(EEONA)-11)," ",EEOCAS,$JUSTIFY(OE,45-$LENGTH(EEOCAS)-5),!,OE,EO,OE
+4 WRITE !,OE,"10.Recommended Information Gathering (list names, documents, and records) |",!,OE,$JUSTIFY(OE,79)
SET CN=CN+1
DO WPB2
if EEOQUIT=1
QUIT
+5 DO FOOT^EEO0210
IF $DATA(^TMP("EEOJ",EEOSJ,7,CN))
GOTO LEND
EX1 KILL EEONAME,EEOTITL,EEOVA,^TMP("EEOJ",EEOSJ),EEOSJ
+1 QUIT
TEST ;Test legnth of word processing fields
+1 if '$DATA(^TMP("EEOJ",EEOSJ,7,CN))
QUIT
if $LENGTH(^TMP("EEOJ",EEOSJ,7,CN))<79
QUIT
FOR CT=1:1
if CT-1*78>$LENGTH(^TMP("EEOJ",EEOSJ,7,CN))
QUIT
SET EEO=78*(CT-1)
Begin DoDot:1
+2 SET EEOD=EEOD+1
+3 SET ^TMP("EEOJ",EEOSJ,7,CN,CT)=$EXTRACT(^TMP("EEOJ",EEOSJ,7,CN),EEO+1,EEO+78)
+4 XECUTE EEOIOF
if EEOQUIT=1
QUIT
+5 WRITE !,OE,^TMP("EEOJ",EEOSJ,7,CN,CT),$JUSTIFY(OE,79-$LENGTH(^TMP("EEOJ",EEOSJ,7,CN,CT)))
End DoDot:1
+6 QUIT
WPB3 ;If more than one page is required for Form 0210
+1 XECUTE EEOIOF
if EEOQUIT=1
QUIT
+2 WRITE !,OE,$JUSTIFY(OE,79),!,OE,$JUSTIFY(OE,79),!,OE,$JUSTIFY("(Recommended Info. Gathering Displayed on Following Page)",67),$JUSTIFY(OE,12)
SET EEO("WP")=1
+3 QUIT
FILL ;Fills in blank lines
+1 FOR CN2=EEOD:1:EEOH
XECUTE EEOIOF
if EEOQUIT=1
QUIT
WRITE !,OE,$JUSTIFY(OE,79)
+2 SET EEOD=0
QUIT
TERMIOF ;
+1 IF $Y'>(IOSL-6)
QUIT
+2 IF IOS=EEOII
IF $GET(EEOQ)'>0
IF '$DATA(IO("S"))
Begin DoDot:1
+3 WRITE !
SET DIR(0)="FAO^0:1^"
SET DIR("A")=" Hit return to continue or ""^"" to exit "
+4 DO ^DIR
if X="^"
SET EEOQUIT=1
+5 WRITE @IOF
QUIT
End DoDot:1
