source: WorldVistAEHR/trunk/r/EEO_COMPLAINT_TRACKING-EEO/EEOIPCON.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1EEOIPCON ;HISC/JWR - POST INIT FIELD 14 FILE 785 CONVERSION ;02/08/93 11:15
2 ;;2.0;EEO Complaint Tracking;;Apr 27, 1995
3EN ;
4 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
5 .Q:$D(^VA(200,COUN))
6 .S EEO(COUN,DA)=COUN
7 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
8 .K CEE,DEE S CEE(LNAME)=$O(^VA(200,"B",LNAME)),DEE(LNAME)=$O(^VA(200,"B",LNAME))
9 .K AEE,BEE F X=$L(FNAME):-1:0 D
10 ..I $D(^VA(200,"B",LNAME_","_FNAME)) S NUM=$O(^(LNAME_","_FNAME,"")) D SET Q
11 ..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),",")
12 ...I BEE(X)'[AEE(X)&(AEE(X)[LNAME_","_$E(FNAME,X)) S NUM=$O(^VA(200,"B",AEE(X),"")) D SET Q
13 ..Q
14 Q:'$D(EEO)
15REPORT 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.",!!
16 S %ZIS="Q" K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP=1 EXIT
17 I $D(IO("Q")) S EEOQ=1,ZTRTN="START^EEOIPCON",ZTSAVE("EEO*")="",ZTDESC=" " D ^%ZTLOAD G EXIT
18 D START G EXIT
19START U IO
20 W !," EEO COUNSELOR'S NAMES CONVERSION:"
21 W !!,"Cases with counselors that are yet to be converted to point to New Person file",!," COUNSELOR'S NAME (FLD #14 FILE #785)",!!
22 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
23 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",!
24 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."
25 D EXIT Q
26SET S N3=0 F S N3=$O(EEO(N1,N3)) Q:N3="" S $P(^EEO(785,N3,1),U)=NUM K EEO(N1,N3)
27 K NUM Q
28NAME I N1["," S LNAME=$P(N1,","),FNAME=$P(N1,",",2)
29 E S LNAME=$P(N1," ",2),FNAME=$P(N1," ") S:LNAME[" " LNAME=$P(LNAME," ",2)
30 Q
31HEAD S EZE=0 W !!," CASE NUMBER COUNSELOR'S NAME",! S $P(EO,"_",63)="" W EO Q
32LINE S CASE=$P($G(^EEO(785,N2,5)),U,6),EZE=EZE+1
33 W !,EZE_"."_$J(" ",5-$L(EZE)),CASE,$J(" ",28-$L(CASE)),N1,$J(" ",35-$L(N1))
34 Q
35EXIT D ^%ZISC K CASE,COUN,DA,EO,LNAME,FNAME,N1,N2,N3,EZE,EEO Q
36 Q
37CLNODE ;Finishes cleaning data from fields that are to be deleted for V. 2.0.
38 S $P(^EEO(785,DA,0),U,6)=""
39 S:$P($G(^EEO(785,DA,5)),U,2)'="" $P(^(5),U,2)=""
40 S EEONO3=$G(^EEO(785,DA,3)) I EEONO3'="" S ^(3)="^^"_$P(EEONO3,U,3)_"^^^"_$P(EEONO3,U,6)
41 S EEONO3=$G(^EEO(785,DA,1)) I EEONO3'="" F NOT=4,5,7,8,9,10 D
42 .S $P(EEONO3,U,NOT)=""
43 S:EEONO3'="" ^EEO(785,DA,1)=EEONO3
44 K EEONO3,NOT Q
Note: See TracBrowser for help on using the repository browser.