- 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 Feb 18, 2025@23:17:11 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