- EEOENF ;HISC/JWR - Informal complaint edit/manipulation routine ;Apr 20, 1995
- ;;2.0;EEO Complaint Tracking;**1,2,5**;Apr 27, 1995
- D ^EEOEOSE
- EN S DIC("S")="I $$SCREEN^EEOEOSE(Y)"
- K DO,DD,D0 S DIC="^EEO(785,",DIC(0)="AELMQZ"
- S DIC("A")="Select NAME: "
- S DLAYGO=785 D ^DIC Q:X="^"!(X="") S EEOY=Y,DA=+Y,DIE=785
- I $TR($G(^EEO(785,DA,4)),"^")'="" D MSG^EEOEOE2 W ! G EN
- I $P(Y,U,3)=1 S DR="98///"_DUZ_";14///"_DUZ_";2///"_EEOYSPTR D ^DIE
- E I '$D(^EEO(785.5,+EEOY)) K DR S EEOFF=785,EEOCTF=785.5 D GATHER
- K DR D CASENO^EEOEOSE
- S (DLAYGO,DIE)=785.5,(DA,DINUM)=+EEOY
- D DRS S EEOFF=785.5,EEOCTF=785 D GATHER,FORMAL^EEOEOE2
- D COUNTER K EEOY,DIC,DR,DIE,DLAYGO,CN,EEO2,EEOF,EEOINF W ! G EN
- GATHER ;
- Q:$P($G(^EEO(EEOFF,+EEOY,1)),U,3)>0!($P($G(^EEO(EEOCTF,+EEOY,1)),U,3)>0)
- F EEO=0,1,5,6 S EEOF(EEO)=$G(^EEO(EEOCTF,+EEOY,EEO))
- F EEO=0,1,5,6 S EEOINF(EEO)=$G(^EEO(EEOFF,+EEOY,EEO))
- F EEO=8,9,10 I $D(^EEO(EEOCTF,+EEOY,EEO)) S EEO1=0 F S EEO1=$O(^(EEO,EEO1)) Q:EEO1'>0 D
- .S EEOF(EEO,EEO1)=$G(^EEO(EEOCTF,+EEOY,EEO,EEO1,0))
- F EEO=8,9,10 I $D(^EEO(EEOFF,+EEOY,EEO)) S EEO1=0 F S EEO1=$O(^EEO(EEOFF,+EEOY,EEO,EEO1)) Q:EEO1'>0 D
- .S EEOINF(EEO,EEO1)=$G(^EEO(EEOFF,+EEOY,EEO,EEO1,0))
- F EEO=0,1,5,6 D
- .Q:$G(EEOINF(EEO))=$G(EEOF(EEO))
- .F CN=1:1:35 D
- ..Q:$P(EEOINF(EEO),U,CN)=$P(EEOF(EEO),U,CN)
- ..Q:'$D(^DD(785,"GL",EEO,CN))
- ..S FLD=$O(^DD(785,"GL",EEO,CN,"")) Q:'$D(^DD(EEOFF,FLD))
- ..S DR=FLD_"///"_$S($P(EEOINF(EEO),U,CN)]"":"/"_$P(EEOINF(EEO),U,CN),1:"@") D DIE
- D MULT Q
- DIE Q:$G(DR)="" S DIE=EEOCTF,DA=+EEOY D ^DIE K DR Q
- MULT ; wipe out multiples and reset based on new values
- F EEO=8,9,10 D
- . K ^EEO(EEOCTF,+EEOY,EEO)
- . N %X,%Y
- . S %X="^EEO(EEOFF,+EEOY,EEO,",%Y="^EEO(EEOCTF,+EEOY,EEO,"
- . D %XY^%RCR
- Q
- MULT01 ;
- S MFILE=$S(EEO=8:785.2,EEO=10:786,EEO=9:785.1,1:"")
- S EEOMU=$P(^EEO(MFILE,$P(EEOINF(EEO,EEO2),U),0),U)
- Q
- DRS ;
- S DR="I $G(^EEO(785,DA,""SEC""))'>0 S Y=.01;98////"_DUZ_";14////"_DUZ_";.01///"_$P(EEOY,U,2)_";1.3///"_EEOZ_";2///"_EEOYSPTR D ^DIE K DR
- S DR=".01;14;.05:.091;5;6.5;6;8;I X="""" S Y=14.5;9:13;14.5;14.7;15.7;I X="""" S Y=16.05;15.9;16.05;16.07;15.5;15;18.5;17.5;19;61;60.5;60;16.5;16.7",DIE=785
- I $G(EEOCOUNS)'>0&($P($G(^EEO(785,D0,1)),U,3)>0) D STATE
- I $G(EEOCOUNS)>0!($P($G(^EEO(785,D0,1)),U,3)'>0) D DRS1
- DIEDR D ^DIE K DR,DIE,EEOFF,EEOCFT,EEOMU Q
- DRS1 ;Entry point to update informal complaint file (785.5)
- S DIE=785.5,DR=".01;14;.05:.091;5;6.5;6;8;I X="""" S Y=14.5;9:13;14.5;14.7;15.7;I X="""" S Y=16.05;15.9;16.05;16.07;15.5;15;18.5;17.5;19;61;60.5;60;16.5;16.7"
- Q
- COUNTER ;
- Q:'$D(^EEO(785.5)) Q:'$D(^(785.5,"ANODE"))
- S EEOIEN=$O(^EEO(785.5,"ANODE","")),(EOIEN,EONUM)=0
- F S EOIEN=$O(^EEO(785.5,"ANODE",EOIEN)) Q:EOIEN'>0 D
- . S EONUM=EONUM+1 Q
- S:EONUM'>0 (EONUM,EEOIEN)=""
- S $P(^EEO(785.5,0),U,3)=EEOIEN,$P(^(0),U,4)=EONUM
- K EEOIEN,EOIEN,EONUM Q
- STATE ;
- S $P(EEO9NF,"*",79)=""
- W !!,EEO9NF,!,"This complaint is now formal, further edits will not be reflected on the",!,"Complaint Intake Form (FORM 0210).",!,EEO9NF,!! K EEO9NF
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOENF 3058 printed Feb 18, 2025@23:17:24 Page 2
- EEOENF ;HISC/JWR - Informal complaint edit/manipulation routine ;Apr 20, 1995
- +1 ;;2.0;EEO Complaint Tracking;**1,2,5**;Apr 27, 1995
- +2 DO ^EEOEOSE
- EN SET DIC("S")="I $$SCREEN^EEOEOSE(Y)"
- +1 KILL DO,DD,D0
- SET DIC="^EEO(785,"
- SET DIC(0)="AELMQZ"
- +2 SET DIC("A")="Select NAME: "
- +3 SET DLAYGO=785
- DO ^DIC
- if X="^"!(X="")
- QUIT
- SET EEOY=Y
- SET DA=+Y
- SET DIE=785
- +4 IF $TRANSLATE($GET(^EEO(785,DA,4)),"^")'=""
- DO MSG^EEOEOE2
- WRITE !
- GOTO EN
- +5 IF $PIECE(Y,U,3)=1
- SET DR="98///"_DUZ_";14///"_DUZ_";2///"_EEOYSPTR
- DO ^DIE
- +6 IF '$TEST
- IF '$DATA(^EEO(785.5,+EEOY))
- KILL DR
- SET EEOFF=785
- SET EEOCTF=785.5
- DO GATHER
- +7 KILL DR
- DO CASENO^EEOEOSE
- +8 SET (DLAYGO,DIE)=785.5
- SET (DA,DINUM)=+EEOY
- +9 DO DRS
- SET EEOFF=785.5
- SET EEOCTF=785
- DO GATHER
- DO FORMAL^EEOEOE2
- +10 DO COUNTER
- KILL EEOY,DIC,DR,DIE,DLAYGO,CN,EEO2,EEOF,EEOINF
- WRITE !
- GOTO EN
- GATHER ;
- +1 if $PIECE($GET(^EEO(EEOFF,+EEOY,1)),U,3)>0!($PIECE($GET(^EEO(EEOCTF,+EEOY,1)),U,3)>0)
- QUIT
- +2 FOR EEO=0,1,5,6
- SET EEOF(EEO)=$GET(^EEO(EEOCTF,+EEOY,EEO))
- +3 FOR EEO=0,1,5,6
- SET EEOINF(EEO)=$GET(^EEO(EEOFF,+EEOY,EEO))
- +4 FOR EEO=8,9,10
- IF $DATA(^EEO(EEOCTF,+EEOY,EEO))
- SET EEO1=0
- FOR
- SET EEO1=$ORDER(^(EEO,EEO1))
- if EEO1'>0
- QUIT
- Begin DoDot:1
- +5 SET EEOF(EEO,EEO1)=$GET(^EEO(EEOCTF,+EEOY,EEO,EEO1,0))
- End DoDot:1
- +6 FOR EEO=8,9,10
- IF $DATA(^EEO(EEOFF,+EEOY,EEO))
- SET EEO1=0
- FOR
- SET EEO1=$ORDER(^EEO(EEOFF,+EEOY,EEO,EEO1))
- if EEO1'>0
- QUIT
- Begin DoDot:1
- +7 SET EEOINF(EEO,EEO1)=$GET(^EEO(EEOFF,+EEOY,EEO,EEO1,0))
- End DoDot:1
- +8 FOR EEO=0,1,5,6
- Begin DoDot:1
- +9 if $GET(EEOINF(EEO))=$GET(EEOF(EEO))
- QUIT
- +10 FOR CN=1:1:35
- Begin DoDot:2
- +11 if $PIECE(EEOINF(EEO),U,CN)=$PIECE(EEOF(EEO),U,CN)
- QUIT
- +12 if '$DATA(^DD(785,"GL",EEO,CN))
- QUIT
- +13 SET FLD=$ORDER(^DD(785,"GL",EEO,CN,""))
- if '$DATA(^DD(EEOFF,FLD))
- QUIT
- +14 SET DR=FLD_"///"_$SELECT($PIECE(EEOINF(EEO),U,CN)]"":"/"_$PIECE(EEOINF(EEO),U,CN),1:"@")
- DO DIE
- End DoDot:2
- End DoDot:1
- +15 DO MULT
- QUIT
- DIE if $GET(DR)=""
- QUIT
- SET DIE=EEOCTF
- SET DA=+EEOY
- DO ^DIE
- KILL DR
- QUIT
- MULT ; wipe out multiples and reset based on new values
- +1 FOR EEO=8,9,10
- Begin DoDot:1
- +2 KILL ^EEO(EEOCTF,+EEOY,EEO)
- +3 NEW %X,%Y
- +4 SET %X="^EEO(EEOFF,+EEOY,EEO,"
- SET %Y="^EEO(EEOCTF,+EEOY,EEO,"
- +5 DO %XY^%RCR
- End DoDot:1
- +6 QUIT
- MULT01 ;
- +1 SET MFILE=$SELECT(EEO=8:785.2,EEO=10:786,EEO=9:785.1,1:"")
- +2 SET EEOMU=$PIECE(^EEO(MFILE,$PIECE(EEOINF(EEO,EEO2),U),0),U)
- +3 QUIT
- DRS ;
- +1 SET DR="I $G(^EEO(785,DA,""SEC""))'>0 S Y=.01;98////"_DUZ_";14////"_DUZ_";.01///"_$PIECE(EEOY,U,2)_";1.3///"_EEOZ_";2///"_EEOYSPTR
- DO ^DIE
- KILL DR
- +2 SET DR=".01;14;.05:.091;5;6.5;6;8;I X="""" S Y=14.5;9:13;14.5;14.7;15.7;I X="""" S Y=16.05;15.9;16.05;16.07;15.5;15;18.5;17.5;19;61;60.5;60;16.5;16.7"
- SET DIE=785
- +3 IF $GET(EEOCOUNS)'>0&($PIECE($GET(^EEO(785,D0,1)),U,3)>0)
- DO STATE
- +4 IF $GET(EEOCOUNS)>0!($PIECE($GET(^EEO(785,D0,1)),U,3)'>0)
- DO DRS1
- DIEDR DO ^DIE
- KILL DR,DIE,EEOFF,EEOCFT,EEOMU
- QUIT
- DRS1 ;Entry point to update informal complaint file (785.5)
- +1 SET DIE=785.5
- SET DR=".01;14;.05:.091;5;6.5;6;8;I X="""" S Y=14.5;9:13;14.5;14.7;15.7;I X="""" S Y=16.05;15.9;16.05;16.07;15.5;15;18.5;17.5;19;61;60.5;60;16.5;16.7"
- +2 QUIT
- COUNTER ;
- +1 if '$DATA(^EEO(785.5))
- QUIT
- if '$DATA(^(785.5,"ANODE"))
- QUIT
- +2 SET EEOIEN=$ORDER(^EEO(785.5,"ANODE",""))
- SET (EOIEN,EONUM)=0
- +3 FOR
- SET EOIEN=$ORDER(^EEO(785.5,"ANODE",EOIEN))
- if EOIEN'>0
- QUIT
- Begin DoDot:1
- +4 SET EONUM=EONUM+1
- QUIT
- End DoDot:1
- +5 if EONUM'>0
- SET (EONUM,EEOIEN)=""
- +6 SET $PIECE(^EEO(785.5,0),U,3)=EEOIEN
- SET $PIECE(^(0),U,4)=EONUM
- +7 KILL EEOIEN,EOIEN,EONUM
- QUIT
- STATE ;
- +1 SET $PIECE(EEO9NF,"*",79)=""
- +2 WRITE !!,EEO9NF,!,"This complaint is now formal, further edits will not be reflected on the",!,"Complaint Intake Form (FORM 0210).",!,EEO9NF,!!
- KILL EEO9NF