source: FOIAVistA/trunk/r/EEO_COMPLAINT_TRACKING-EEO/EEO211.m@ 1397

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