89 lines
4.8 KiB
Mathematica
89 lines
4.8 KiB
Mathematica
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
|