EEOIPOS2 ;HISC/JWR - POST INIT CLEANUP ;02/08/93 11:15
;;2.0;EEO Complaint Tracking;;Apr 27, 1995
TEST ;Loop through DA's for file 785 for conversion
S (NO,STATE,N5,ADD,ZIP,DA,ICC)=""
F S DA=$O(^EEO(785,"ANODE",DA)) Q:DA="" D SET,CLNODE^EEOIPCON W "."
G KILL
SET ;Global sets for new and rearranged fields
Q:'$D(^EEO(785,DA,0)) S EEO0=^EEO(785,DA,0),STATE=$P(EEO0,"^",6) S EEO5=$G(^EEO(785,DA,5)),ADD=$P(EEO5,"^",2),ZIP=$P(ADD,",",2),CITY=$P(ADD,",",1)
D STRIP K EEO3,EEO1
S:$D(^EEO(785,DA,3)) EEO3=^(3) S:$D(^EEO(785,DA,1)) EEO1=^EEO(785,DA,1)
D IN1,BASIS
Q
STRIP ;Breaks doun City, State, Zip, and assigns value to Case No field
S ZIP=$TR(ZIP," ABCDEFGHIJKLMNOPQRSTUVWXYZ.,")
I STATE'="" S $P(^EEO(785,DA,5),"^",4)=STATE
I CITY'="" S $P(^EEO(785,DA,5),"^",3)=CITY
I ZIP?5N!(ZIP?5N1"-"4N) S $P(^EEO(785,DA,5),"^",5)=ZIP
S CASE=$S('$D(^EEO(785,DA,1)):"P",'$P(^(1),"^",3):"P",$E($P(^(1),"^",3),4,5)>9:$E($P(^(1),"^",3),2,3)+1,1:$E($P(^(1),"^",3),2,3))
S CASE=CASE_"-"_(DA\100000)_"-"_(100000-(DA-((DA\100000)*100000)))
S $P(^EEO(785,DA,5),"^",6)=CASE
S (ADD,ZIP,N5,STATE,CITY,CASE,ICC)=""
S DIE=785,DR=".07///@;7///@;19///@" D ^DIE
Q
KILL ;Kills some obsolete fields and files, Reindexes certain fields in 785
W !!,"DELETING OBSOLETE AND DUPLICATED FIELDS FROM FILE 785 "
S DIK="^DD(785,",DA(1)=785 F DA=.07,1,7,17,17.1,17.2,18,18.1,18.2,27,28,30,31,33.5,33.6,33.7,33.8,34,35,36,37,38,39,39.5,39.6,39.7,39.8,40,43 W "." D ^DIK
W !,"DELETING OBSOLETE FILES "
F FI=787,788,789.2,789.3,789.4,789.6 I $D(^EEO(FI,0)) S DIU="^EEO("_FI_",",DIU(0)="DST" W !," ",FI D EN^DIU2
K FI,ANS,DA,DA(1),DIC,DIE,DIK,DR,NO,X
W !!!!,"RE-INDEXING 'C','D',& 'E' CROSS REFERENCES (FILE #785)"
S DIK="^EEO(785," F DIK(1)=2,1.2,1.3 D ENALL^DIK
OPT S DIE="^DIC(19," W !!,"PLACING OBSOLETE OPTIONS OUT OF ORDER"
F EEOPTION="EEO TASKED UPLINK BULLETIN","EEOREXMIT" D
.I $D(^DIC(19,"B",EEOPTION)) S DA=$O(^(EEOPTION,"")) I DA>0 S DR="2///OUT OF ORDER;25///@" D ^DIE
D COUNTER^EEOENF
W !! D ^EEOIPCON
W !!!," *** INITIALIZATION COMPLETE ***",!!!," Remember to Task the EEO TASKED BULLETIN option to run nightly...",!!!!!
K DIK,EEO1IN,EEO0,EEO31,EEO5,EEONI,ICC,ZIP,STATE,N5,ADD,CITY Q
IN1 ;Converts Investigator fields to the new multiple format
Q:$G(EEO3)'>0
F EEONI=1,2,7,10 I $P($G(EEO3),U,EEONI)'="" D
.S EEO31=$P($G(EEO3),U,EEONI) I $D(^EEO(787.5,EEO31)) D PRE
.I EEO31<1000,$D(^EEO(787,EEO31)) D
..S X=EEO31,DIC="^EEO(787.5,",DIC(0)="M"
..D ^DIC I Y'>0 S $P(EEO3,U,EEONI)=2126 Q
..S $P(EEO3,U,EEONI)=+Y
..D PRE
.;I $P($G(EEO3),U,EEONI)'="" I '$D(^EEO(787.5,$P($G(EEO3),U,EEONI)))&('$D(^EEO(787,$P($G(EEO3),U,EEONI)))) S $P(EEO3,U,EEONI)=2126
S (SPIT,EEOINV1,EEOINV2)=""
I $P(EEO3,U)'="" S EEOINV1=$P(EEO3,U)_"^"_$P(EEO3,U,3)_"^"_$G(EEOIN(1))_"^^"_$P(EEO3,U,5)_"^"_$P(EEO3,U,2)_"^"_$P(EEO3,U,4)_"^"_$P(EEO3,U,8) S SPIT=1
I $P(EEO3,U,7)'="" S EEOINV2=$P(EEO3,U,7)_"^"_$P(EEO3,U,9)_"^"_$G(EEOIN(7))_"^^"_$P(EEO3,U,11)_"^"_$P(EEO3,U,10)_"^"_$P(EEO3,U,13)_"^"_$P(EEO3,U,14) S:SPIT=1 SPIT=2
I SPIT>0 S ^EEO(785,DA,11,1,0)=$S($P(EEO3,U)'="":EEOINV1,1:EEOINV2) S ^EEO(785,DA,11,"B",$P(EEO3,U),1)=""
I SPIT=2 S ^EEO(785,DA,11,SPIT,0)=EEOINV2 S ^EEO(785,DA,11,"B",$P(EEO3,U,7),2)=""
S:SPIT'="" ^EEO(785,DA,11,0)="^785.03P^"_SPIT_"^"_SPIT
I $D(^EEO(785,DA,3)) S EEOOINV=$G(^(3)),^(3)="^^"_$P(EEOOINV,U,3)_"^^^"_$P(EEOOINV,U,6)
K EEOINV1,EEOINV2,SPIT,INV1,DA1,FIN1,REVI1,RAD,RRD,INV2,DA2,FIN2,REVI2,REVD2,RRD2,N3,EEOOINV
Q
PRE ;Makes type of investigator determination
I EEONI=1 S EEO1IN=$P(EEO3,U),EEODOA=$P(EEO3,U,3) D TYPE
I EEONI=7 S EEO1IN=$P(EEO3,U,7),EEODOA=$P(EEO3,U,9) D TYPE
Q
BASIS ;Converts basis to new multiple format
K BA,IS I $G(EEO1)'="" D
.S BA(1)=$P(EEO1,U,5),BA(2)=$P(EEO1,U,7),BA(3)=$P(EEO1,U,8)
.F NO=1:1:3 D
..I BA(NO)'="" I $D(^EEO(785.1,BA(NO))) S BA(NO)=$P(^(BA(NO),0),U)
.S IS(1)=$P(EEO1,U,4),IS(2)=$P(EEO1,U,9),IS(3)=$P(EEO1,U,10)
.F NO=1:1:3 D
..I IS(NO)'="" I $D(^EEO(786,IS(NO))) S IS(NO)=$P(^(IS(NO),0),U)
SETB .F NO=1:1:3 I $G(BA(NO))'="" D BA
.F NO=1:1:3 I $G(IS(NO))'="" D IS
K BA1,BA2,BA3,IS1,IS2,IS3,LAB,NO,N1,BA,IS
S $P(^EEO(785,DA,2),U,8)=""
I $D(^EEO(785,DA,1)) S EEOOIS=$G(^(1)) D
.F EX=4,5,7,8,9,10 S $P(EEOOIS,U,EX)=""
.S ^EEO(785,DA,1)=EEOOIS
K EEOOIS,EX Q
BA ;Enters converted Basis into file 785
S DR="18.5///"_BA(NO),DR(2,785.01)=".01///"_BA(NO)
DIE S DIE=785 D ^DIE K DR Q
IS ;Enters converted Issue codes into file 785
S DR="17.5///"_IS(NO),DR(2,785.02)=".01///"_IS(NO)_";1///"_$P(EEO1,U,11)
D DIE
Q
TYPE S (EEODATE,EEOIN(EEONI))="",EEOCN=0
Q:EEODOA'>0
Q:'$D(^EEO(787.5,EEO1IN)) I $D(^(EEO1IN,1)) F S EEOCN=$O(^(1,EEOCN)) Q:EEOCN'>0 N AEE S AEE=$G(^(EEOCN,0)) D
.I $P(AEE,U,2)<EEODOA&($P(AEE,U,3)>EEODOA!($P(AEE,U,3)="")) I EEODATE'>EEODOA S EEODATE=EEODOA,EEOIN(EEONI)=$P(AEE,U)
I $D(^EEO(787.5,EEO1IN,1))&(EEOIN(EEONI)'>0) S EEOIN(EEONI)=$P($G(^(1,1,0)),U)
K EEODATE,EEODOA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOIPOS2 4967 printed Nov 22, 2024@17:01:24 Page 2
EEOIPOS2 ;HISC/JWR - POST INIT CLEANUP ;02/08/93 11:15
+1 ;;2.0;EEO Complaint Tracking;;Apr 27, 1995
TEST ;Loop through DA's for file 785 for conversion
+1 SET (NO,STATE,N5,ADD,ZIP,DA,ICC)=""
+2 FOR
SET DA=$ORDER(^EEO(785,"ANODE",DA))
if DA=""
QUIT
DO SET
DO CLNODE^EEOIPCON
WRITE "."
+3 GOTO KILL
SET ;Global sets for new and rearranged fields
+1 if '$DATA(^EEO(785,DA,0))
QUIT
SET EEO0=^EEO(785,DA,0)
SET STATE=$PIECE(EEO0,"^",6)
SET EEO5=$GET(^EEO(785,DA,5))
SET ADD=$PIECE(EEO5,"^",2)
SET ZIP=$PIECE(ADD,",",2)
SET CITY=$PIECE(ADD,",",1)
+2 DO STRIP
KILL EEO3,EEO1
+3 if $DATA(^EEO(785,DA,3))
SET EEO3=^(3)
if $DATA(^EEO(785,DA,1))
SET EEO1=^EEO(785,DA,1)
+4 DO IN1
DO BASIS
+5 QUIT
STRIP ;Breaks doun City, State, Zip, and assigns value to Case No field
+1 SET ZIP=$TRANSLATE(ZIP," ABCDEFGHIJKLMNOPQRSTUVWXYZ.,")
+2 IF STATE'=""
SET $PIECE(^EEO(785,DA,5),"^",4)=STATE
+3 IF CITY'=""
SET $PIECE(^EEO(785,DA,5),"^",3)=CITY
+4 IF ZIP?5N!(ZIP?5N1"-"4N)
SET $PIECE(^EEO(785,DA,5),"^",5)=ZIP
+5 SET CASE=$SELECT('$DATA(^EEO(785,DA,1)):"P",'$PIECE(^(1),"^",3):"P",$EXTRACT($PIECE(^(1),"^",3),4,5)>9:$EXTRACT($PIECE(^(1),"^",3),2,3)+1,1:$EXTRACT($PIECE(^(1),"^",3),2,3))
+6 SET CASE=CASE_"-"_(DA\100000)_"-"_(100000-(DA-((DA\100000)*100000)))
+7 SET $PIECE(^EEO(785,DA,5),"^",6)=CASE
+8 SET (ADD,ZIP,N5,STATE,CITY,CASE,ICC)=""
+9 SET DIE=785
SET DR=".07///@;7///@;19///@"
DO ^DIE
+10 QUIT
KILL ;Kills some obsolete fields and files, Reindexes certain fields in 785
+1 WRITE !!,"DELETING OBSOLETE AND DUPLICATED FIELDS FROM FILE 785 "
+2 SET DIK="^DD(785,"
SET DA(1)=785
FOR DA=.07,1,7,17,17.1,17.2,18,18.1,18.2,27,28,30,31,33.5,33.6,33.7,33.8,34,35,36,37,38,39,39.5,39.6,39.7,39.8,40,43
WRITE "."
DO ^DIK
+3 WRITE !,"DELETING OBSOLETE FILES "
+4 FOR FI=787,788,789.2,789.3,789.4,789.6
IF $DATA(^EEO(FI,0))
SET DIU="^EEO("_FI_","
SET DIU(0)="DST"
WRITE !," ",FI
DO EN^DIU2
+5 KILL FI,ANS,DA,DA(1),DIC,DIE,DIK,DR,NO,X
+6 WRITE !!!!,"RE-INDEXING 'C','D',& 'E' CROSS REFERENCES (FILE #785)"
+7 SET DIK="^EEO(785,"
FOR DIK(1)=2,1.2,1.3
DO ENALL^DIK
OPT SET DIE="^DIC(19,"
WRITE !!,"PLACING OBSOLETE OPTIONS OUT OF ORDER"
+1 FOR EEOPTION="EEO TASKED UPLINK BULLETIN","EEOREXMIT"
Begin DoDot:1
+2 IF $DATA(^DIC(19,"B",EEOPTION))
SET DA=$ORDER(^(EEOPTION,""))
IF DA>0
SET DR="2///OUT OF ORDER;25///@"
DO ^DIE
End DoDot:1
+3 DO COUNTER^EEOENF
+4 WRITE !!
DO ^EEOIPCON
+5 WRITE !!!," *** INITIALIZATION COMPLETE ***",!!!," Remember to Task the EEO TASKED BULLETIN option to run nightly...",!!!!!
+6 KILL DIK,EEO1IN,EEO0,EEO31,EEO5,EEONI,ICC,ZIP,STATE,N5,ADD,CITY
QUIT
IN1 ;Converts Investigator fields to the new multiple format
+1 if $GET(EEO3)'>0
QUIT
+2 FOR EEONI=1,2,7,10
IF $PIECE($GET(EEO3),U,EEONI)'=""
Begin DoDot:1
+3 SET EEO31=$PIECE($GET(EEO3),U,EEONI)
IF $DATA(^EEO(787.5,EEO31))
DO PRE
+4 IF EEO31<1000
IF $DATA(^EEO(787,EEO31))
Begin DoDot:2
+5 SET X=EEO31
SET DIC="^EEO(787.5,"
SET DIC(0)="M"
+6 DO ^DIC
IF Y'>0
SET $PIECE(EEO3,U,EEONI)=2126
QUIT
+7 SET $PIECE(EEO3,U,EEONI)=+Y
+8 DO PRE
End DoDot:2
+9 ;I $P($G(EEO3),U,EEONI)'="" I '$D(^EEO(787.5,$P($G(EEO3),U,EEONI)))&('$D(^EEO(787,$P($G(EEO3),U,EEONI)))) S $P(EEO3,U,EEONI)=2126
End DoDot:1
+10 SET (SPIT,EEOINV1,EEOINV2)=""
+11 IF $PIECE(EEO3,U)'=""
SET EEOINV1=$PIECE(EEO3,U)_"^"_$PIECE(EEO3,U,3)_"^"_$GET(EEOIN(1))_"^^"_$PIECE(EEO3,U,5)_"^"_$PIECE(EEO3,U,2)_"^"_$PIECE(EEO3,U,4)_"^"_$PIECE(EEO3,U,8)
SET SPIT=1
+12 IF $PIECE(EEO3,U,7)'=""
SET EEOINV2=$PIECE(EEO3,U,7)_"^"_$PIECE(EEO3,U,9)_"^"_$GET(EEOIN(7))_"^^"_$PIECE(EEO3,U,11)_"^"_$PIECE(EEO3,U,10)_"^"_$PIECE(EEO3,U,13)_"^"_$PIECE(EEO3,U,14)
if SPIT=1
SET SPIT=2
+13 IF SPIT>0
SET ^EEO(785,DA,11,1,0)=$SELECT($PIECE(EEO3,U)'="":EEOINV1,1:EEOINV2)
SET ^EEO(785,DA,11,"B",$PIECE(EEO3,U),1)=""
+14 IF SPIT=2
SET ^EEO(785,DA,11,SPIT,0)=EEOINV2
SET ^EEO(785,DA,11,"B",$PIECE(EEO3,U,7),2)=""
+15 if SPIT'=""
SET ^EEO(785,DA,11,0)="^785.03P^"_SPIT_"^"_SPIT
+16 IF $DATA(^EEO(785,DA,3))
SET EEOOINV=$GET(^(3))
SET ^(3)="^^"_$PIECE(EEOOINV,U,3)_"^^^"_$PIECE(EEOOINV,U,6)
+17 KILL EEOINV1,EEOINV2,SPIT,INV1,DA1,FIN1,REVI1,RAD,RRD,INV2,DA2,FIN2,REVI2,REVD2,RRD2,N3,EEOOINV
+18 QUIT
PRE ;Makes type of investigator determination
+1 IF EEONI=1
SET EEO1IN=$PIECE(EEO3,U)
SET EEODOA=$PIECE(EEO3,U,3)
DO TYPE
+2 IF EEONI=7
SET EEO1IN=$PIECE(EEO3,U,7)
SET EEODOA=$PIECE(EEO3,U,9)
DO TYPE
+3 QUIT
BASIS ;Converts basis to new multiple format
+1 KILL BA,IS
IF $GET(EEO1)'=""
Begin DoDot:1
+2 SET BA(1)=$PIECE(EEO1,U,5)
SET BA(2)=$PIECE(EEO1,U,7)
SET BA(3)=$PIECE(EEO1,U,8)
+3 FOR NO=1:1:3
Begin DoDot:2
+4 IF BA(NO)'=""
IF $DATA(^EEO(785.1,BA(NO)))
SET BA(NO)=$PIECE(^(BA(NO),0),U)
End DoDot:2
+5 SET IS(1)=$PIECE(EEO1,U,4)
SET IS(2)=$PIECE(EEO1,U,9)
SET IS(3)=$PIECE(EEO1,U,10)
+6 FOR NO=1:1:3
Begin DoDot:2
+7 IF IS(NO)'=""
IF $DATA(^EEO(786,IS(NO)))
SET IS(NO)=$PIECE(^(IS(NO),0),U)
End DoDot:2
SETB FOR NO=1:1:3
IF $GET(BA(NO))'=""
DO BA
+1 FOR NO=1:1:3
IF $GET(IS(NO))'=""
DO IS
End DoDot:1
+2 KILL BA1,BA2,BA3,IS1,IS2,IS3,LAB,NO,N1,BA,IS
+3 SET $PIECE(^EEO(785,DA,2),U,8)=""
+4 IF $DATA(^EEO(785,DA,1))
SET EEOOIS=$GET(^(1))
Begin DoDot:1
+5 FOR EX=4,5,7,8,9,10
SET $PIECE(EEOOIS,U,EX)=""
+6 SET ^EEO(785,DA,1)=EEOOIS
End DoDot:1
+7 KILL EEOOIS,EX
QUIT
BA ;Enters converted Basis into file 785
+1 SET DR="18.5///"_BA(NO)
SET DR(2,785.01)=".01///"_BA(NO)
DIE SET DIE=785
DO ^DIE
KILL DR
QUIT
IS ;Enters converted Issue codes into file 785
+1 SET DR="17.5///"_IS(NO)
SET DR(2,785.02)=".01///"_IS(NO)_";1///"_$PIECE(EEO1,U,11)
+2 DO DIE
+3 QUIT
TYPE SET (EEODATE,EEOIN(EEONI))=""
SET EEOCN=0
+1 if EEODOA'>0
QUIT
+2 if '$DATA(^EEO(787.5,EEO1IN))
QUIT
IF $DATA(^(EEO1IN,1))
FOR
SET EEOCN=$ORDER(^(1,EEOCN))
if EEOCN'>0
QUIT
NEW AEE
SET AEE=$GET(^(EEOCN,0))
Begin DoDot:1
+3 IF $PIECE(AEE,U,2)<EEODOA&($PIECE(AEE,U,3)>EEODOA!($PIECE(AEE,U,3)=""))
IF EEODATE'>EEODOA
SET EEODATE=EEODOA
SET EEOIN(EEONI)=$PIECE(AEE,U)
End DoDot:1
+4 IF $DATA(^EEO(787.5,EEO1IN,1))&(EEOIN(EEONI)'>0)
SET EEOIN(EEONI)=$PIECE($GET(^(1,1,0)),U)
+5 KILL EEODATE,EEODOA
