- EEOIPCON ;HISC/JWR - POST INIT FIELD 14 FILE 785 CONVERSION ;02/08/93 11:15
- ;;2.0;EEO Complaint Tracking;;Apr 27, 1995
- EN ;
- K EEO S DA=0 F S DA=$O(^EEO(785,DA)) Q:DA'>0 I $P($G(^(DA,1)),U)'="" S COUN=$P($G(^(1)),U) D
- .Q:$D(^VA(200,COUN))
- .S EEO(COUN,DA)=COUN
- S N1=0 F S N1=$O(EEO(N1)) Q:N1="" S N2=0 F S N2=$O(EEO(N1,N2)) Q:N2="" D NAME Q:LNAME="" D
- .K CEE,DEE S CEE(LNAME)=$O(^VA(200,"B",LNAME)),DEE(LNAME)=$O(^VA(200,"B",LNAME))
- .K AEE,BEE F X=$L(FNAME):-1:0 D
- ..I $D(^VA(200,"B",LNAME_","_FNAME)) S NUM=$O(^(LNAME_","_FNAME,"")) D SET Q
- ..S AEE(X)=$O(^VA(200,"B",LNAME_","_$E(FNAME,X))),BEE(X)=$O(^VA(200,"B",AEE(X))) D:$P(CEE(LNAME),",")[$P(AEE(X),",")
- ...I BEE(X)'[AEE(X)&(AEE(X)[LNAME_","_$E(FNAME,X)) S NUM=$O(^VA(200,"B",AEE(X),"")) D SET Q
- ..Q
- Q:'$D(EEO)
- REPORT W !!,"The Counselor's Name Field (#14, File 785) has been changed from free text",!,"to a pointer to File 200, enter a device to print the names of counselor's",!,"who could not be converted.",!!
- S %ZIS="Q" K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP=1 EXIT
- I $D(IO("Q")) S EEOQ=1,ZTRTN="START^EEOIPCON",ZTSAVE("EEO*")="",ZTDESC=" " D ^%ZTLOAD G EXIT
- D START G EXIT
- START U IO
- W !," EEO COUNSELOR'S NAMES CONVERSION:"
- W !!,"Cases with counselors that are yet to be converted to point to New Person file",!," COUNSELOR'S NAME (FLD #14 FILE #785)",!!
- D HEAD S N1="" F S N1=$O(EEO(N1)) Q:N1="" S N2=0 F S N2=$O(EEO(N1,N2)) Q:N2="" D LINE
- W !!,"This list contains the names of counselors who must be converted manually to",!,"reflect their New Person file entry. The IRM may do this by editing",!,"field # 14 (Counselor's Name) of file 785 (EEO Complaints) through VA File",!
- W "Man and changing the above listed name to the correct New Person name (in File ",!,"200), or the EEO Specialist may edit this through the Enter/Edit Formal",!,"Complaint Info option."
- D EXIT Q
- SET S N3=0 F S N3=$O(EEO(N1,N3)) Q:N3="" S $P(^EEO(785,N3,1),U)=NUM K EEO(N1,N3)
- K NUM Q
- NAME I N1["," S LNAME=$P(N1,","),FNAME=$P(N1,",",2)
- E S LNAME=$P(N1," ",2),FNAME=$P(N1," ") S:LNAME[" " LNAME=$P(LNAME," ",2)
- Q
- HEAD S EZE=0 W !!," CASE NUMBER COUNSELOR'S NAME",! S $P(EO,"_",63)="" W EO Q
- LINE S CASE=$P($G(^EEO(785,N2,5)),U,6),EZE=EZE+1
- W !,EZE_"."_$J(" ",5-$L(EZE)),CASE,$J(" ",28-$L(CASE)),N1,$J(" ",35-$L(N1))
- Q
- EXIT D ^%ZISC K CASE,COUN,DA,EO,LNAME,FNAME,N1,N2,N3,EZE,EEO Q
- Q
- CLNODE ;Finishes cleaning data from fields that are to be deleted for V. 2.0.
- S $P(^EEO(785,DA,0),U,6)=""
- S:$P($G(^EEO(785,DA,5)),U,2)'="" $P(^(5),U,2)=""
- S EEONO3=$G(^EEO(785,DA,3)) I EEONO3'="" S ^(3)="^^"_$P(EEONO3,U,3)_"^^^"_$P(EEONO3,U,6)
- S EEONO3=$G(^EEO(785,DA,1)) I EEONO3'="" F NOT=4,5,7,8,9,10 D
- .S $P(EEONO3,U,NOT)=""
- S:EEONO3'="" ^EEO(785,DA,1)=EEONO3
- K EEONO3,NOT Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOIPCON 2846 printed Mar 13, 2025@20:55:53 Page 2
- EEOIPCON ;HISC/JWR - POST INIT FIELD 14 FILE 785 CONVERSION ;02/08/93 11:15
- +1 ;;2.0;EEO Complaint Tracking;;Apr 27, 1995
- EN ;
- +1 KILL EEO
- SET DA=0
- FOR
- SET DA=$ORDER(^EEO(785,DA))
- if DA'>0
- QUIT
- IF $PIECE($GET(^(DA,1)),U)'=""
- SET COUN=$PIECE($GET(^(1)),U)
- Begin DoDot:1
- +2 if $DATA(^VA(200,COUN))
- QUIT
- +3 SET EEO(COUN,DA)=COUN
- End DoDot:1
- +4 SET N1=0
- FOR
- SET N1=$ORDER(EEO(N1))
- if N1=""
- QUIT
- SET N2=0
- FOR
- SET N2=$ORDER(EEO(N1,N2))
- if N2=""
- QUIT
- DO NAME
- if LNAME=""
- QUIT
- Begin DoDot:1
- +5 KILL CEE,DEE
- SET CEE(LNAME)=$ORDER(^VA(200,"B",LNAME))
- SET DEE(LNAME)=$ORDER(^VA(200,"B",LNAME))
- +6 KILL AEE,BEE
- FOR X=$LENGTH(FNAME):-1:0
- Begin DoDot:2
- +7 IF $DATA(^VA(200,"B",LNAME_","_FNAME))
- SET NUM=$ORDER(^(LNAME_","_FNAME,""))
- DO SET
- QUIT
- +8 SET AEE(X)=$ORDER(^VA(200,"B",LNAME_","_$EXTRACT(FNAME,X)))
- SET BEE(X)=$ORDER(^VA(200,"B",AEE(X)))
- if $PIECE(CEE(LNAME),",")[$PIECE(AEE(X),",")
- Begin DoDot:3
- +9 IF BEE(X)'[AEE(X)&(AEE(X)[LNAME_","_$EXTRACT(FNAME,X))
- SET NUM=$ORDER(^VA(200,"B",AEE(X),""))
- DO SET
- QUIT
- End DoDot:3
- +10 QUIT
- End DoDot:2
- End DoDot:1
- +11 if '$DATA(EEO)
- QUIT
- REPORT WRITE !!,"The Counselor's Name Field (#14, File 785) has been changed from free text",!,"to a pointer to File 200, enter a device to print the names of counselor's",!,"who could not be converted.",!!
- +1 SET %ZIS="Q"
- KILL IOP,ZTIO,ZTSAVE
- DO ^%ZIS
- if POP=1
- GOTO EXIT
- +2 IF $DATA(IO("Q"))
- SET EEOQ=1
- SET ZTRTN="START^EEOIPCON"
- SET ZTSAVE("EEO*")=""
- SET ZTDESC=" "
- DO ^%ZTLOAD
- GOTO EXIT
- +3 DO START
- GOTO EXIT
- START USE IO
- +1 WRITE !," EEO COUNSELOR'S NAMES CONVERSION:"
- +2 WRITE !!,"Cases with counselors that are yet to be converted to point to New Person file",!," COUNSELOR'S NAME (FLD #14 FILE #785)",!!
- +3 DO HEAD
- SET N1=""
- FOR
- SET N1=$ORDER(EEO(N1))
- if N1=""
- QUIT
- SET N2=0
- FOR
- SET N2=$ORDER(EEO(N1,N2))
- if N2=""
- QUIT
- DO LINE
- +4 WRITE !!,"This list contains the names of counselors who must be converted manually to",!,"reflect their New Person file entry. The IRM may do this by editing",!,"field # 14 (Counselor's Name) of file 785 (EEO Complaints) through VA File",!
- +5 WRITE "Man and changing the above listed name to the correct New Person name (in File ",!,"200), or the EEO Specialist may edit this through the Enter/Edit Formal",!,"Complaint Info option."
- +6 DO EXIT
- QUIT
- SET SET N3=0
- FOR
- SET N3=$ORDER(EEO(N1,N3))
- if N3=""
- QUIT
- SET $PIECE(^EEO(785,N3,1),U)=NUM
- KILL EEO(N1,N3)
- +1 KILL NUM
- QUIT
- NAME IF N1[","
- SET LNAME=$PIECE(N1,",")
- SET FNAME=$PIECE(N1,",",2)
- +1 IF '$TEST
- SET LNAME=$PIECE(N1," ",2)
- SET FNAME=$PIECE(N1," ")
- if LNAME[" "
- SET LNAME=$PIECE(LNAME," ",2)
- +2 QUIT
- HEAD SET EZE=0
- WRITE !!," CASE NUMBER COUNSELOR'S NAME",!
- SET $PIECE(EO,"_",63)=""
- WRITE EO
- QUIT
- LINE SET CASE=$PIECE($GET(^EEO(785,N2,5)),U,6)
- SET EZE=EZE+1
- +1 WRITE !,EZE_"."_$JUSTIFY(" ",5-$LENGTH(EZE)),CASE,$JUSTIFY(" ",28-$LENGTH(CASE)),N1,$JUSTIFY(" ",35-$LENGTH(N1))
- +2 QUIT
- EXIT DO ^%ZISC
- KILL CASE,COUN,DA,EO,LNAME,FNAME,N1,N2,N3,EZE,EEO
- QUIT
- +1 QUIT
- CLNODE ;Finishes cleaning data from fields that are to be deleted for V. 2.0.
- +1 SET $PIECE(^EEO(785,DA,0),U,6)=""
- +2 if $PIECE($GET(^EEO(785,DA,5)),U,2)'=""
- SET $PIECE(^(5),U,2)=""
- +3 SET EEONO3=$GET(^EEO(785,DA,3))
- IF EEONO3'=""
- SET ^(3)="^^"_$PIECE(EEONO3,U,3)_"^^^"_$PIECE(EEONO3,U,6)
- +4 SET EEONO3=$GET(^EEO(785,DA,1))
- IF EEONO3'=""
- FOR NOT=4,5,7,8,9,10
- Begin DoDot:1
- +5 SET $PIECE(EEONO3,U,NOT)=""
- End DoDot:1
- +6 if EEONO3'=""
- SET ^EEO(785,DA,1)=EEONO3
- +7 KILL EEONO3,NOT
- QUIT
