ESPSCR1 ;DALISC/CKA - OFFENSE REPORT SCREENS-NAMES & NARRATIVE;2/93
;;1.0;POLICE & SECURITY;**12**;Mar 31, 1994
EN Q ;CALLED FROM ESPOFF
COMP ;COMPLAINANT SCREEN
S ESPNOT=0
F ESPN=1:1 Q:'$D(ESPFN)&(ESPN'=1)!($D(DTOUT)) D Q:ESPNOT
. I $D(^TMP($J,"UOR","C",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","C")
. Q:ESPNOT
. W !!,"COMPLAINANT #",ESPN
. K ESPFN D EN^ESPMNI
. I $D(ESPFN),(ESPFN>0) S ^TMP($J,"UOR","C",ESPN)=ESPFN
QUIT
VIC ;VICTIM SCREEN
S ESPNOT=0
F ESPN=1:1 Q:'$D(ESPFN)&(ESPN'=1)!($D(DTOUT)) D Q:ESPNOT
. I $D(^TMP($J,"UOR","V",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","V")
. Q:ESPNOT
. W !!,"VICTIM #",ESPN
. K ESPFN D EN^ESPMNI
. Q:$D(DTOUT)
. I $D(ESPFN),(ESPFN>0) S ^TMP($J,"UOR","V",ESPN)=ESPFN W !,"MEDICAL TREATMENT: " S DWLW=80,DWPK=1,DIC="^TMP($J,""MT"","_ESPN_",",DIWESUB="MEDICAL TREATMENT" D EN^DIWE
QUIT
WIT ;WITNESS SCREEN
S ESPNOT=0
F ESPN=1:1 Q:'$D(ESPFN)&(ESPN'=1)!($D(DTOUT)) D Q:ESPNOT
. I $D(^TMP($J,"UOR","W",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","W")
. Q:ESPNOT
. W !!,"WITNESS #",ESPN
. K ESPFN D EN^ESPMNI
. I $D(ESPFN),(ESPFN>0) S ^TMP($J,"UOR","W",ESPN)=ESPFN
QUIT
NARR ;NARRATIVE SCREEN
W !!,"ORIGIN:"
S DWLW=80,DWPK=1,DIC="^TMP($J,""N1"",",DIWESUB="ORIGIN" D EN^DIWE
I $D(DTOUT) S NOUPD=1 Q
W !!,"INITIAL OBSERVATION:"
S DWLW=80,DWPK=1,DIC="^TMP($J,""N2"",",DIWESUB="INITIAL OBSERVATION" D EN^DIWE
I $D(DTOUT) S NOUPD=1 Q
W !!,"INVESTIGATION:"
S DWLW=80,DWPK=1,DIC="^TMP($J,""N3"",",DIWESUB="INVESTIGATION" D EN^DIWE
I $D(DTOUT) S NOUPD=1 Q
W !!,"DISPOSITION:"
S DWLW=80,DWPK=1,DIC="^TMP($J,""N4"",",DIWESUB="DISPOSITION" D EN^DIWE
I $D(DTOUT) S NOUPD=1 Q
QUIT
NOTIF ;NOTIFICATIONS SCREEN INPUT
S ESPNOT=0 K DIRUT
F ESPN=1:1 Q:$D(DIRUT) D OAN Q:ESPNOT
Q:$D(DTOUT)
S ESPNOT=0 K DIRUT
F ESPN=1:1 Q:$D(DIRUT) D ATY Q:ESPNOT!($D(DTOUT))
QUIT
NOTIN ;NOTIFICATIONS INPUT
OAN ;OTHER AGENCY NOTIFIED
I $D(^TMP($J,"UOR","OTH",ESPN)) D WARN I 'ESPNOT K ^TMP("UOR","OTH")
QUIT:ESPNOT
W !!,"OTHER AGENCY"
OAG S DIR(0)="912.14,.01" D RD Q:$D(DIRUT) S ESPD(.01)=Y
CONT S DIR(0)="912.14,.02" D RD G:$D(DUOUT) SNO G:$D(DTOUT) NOUPD S ESPD(.02)=Y
AG S DIR(0)="912.14,.03" D RD G:$D(DUOUT) SNO G:$D(DTOUT) NOUPD S ESPD(.03)=Y
SNO S ^TMP($J,"UOR","OTH",ESPN)=ESPD(.01)_"^"_$G(ESPD(.02))_"^"_$G(ESPD(.03))
K DIRUT
QUIT
ATY ;U.S. ATTORNEY NOTIFIED
I $D(^TMP($J,"UOR","ATY",ESPN)) D WARN I 'ESPNOT K ^TMP("UOR","ATY")
QUIT:ESPNOT
W !!,"U.S. ATTORNEY"
S DIR(0)="912.15,.01" D RD Q:$D(DIRUT) S ESPD(.01)=Y
INSTR W !,"Instructions Received: " S DWLW=80,DWPK=1,DIC="^TMP($J,""INS"","_ESPN_",",DIWESUB="Instructions Received" D EN^DIWE
I $D(DTOUT) S NOUPD=1 Q
S ^TMP($J,"UOR","ATY",ESPN)=ESPD(.01)_"^"
QUIT
HELD ;PROPERTY (HELD) SCREEN INPUT
S ESPNOT=0 K DIRUT
F ESPN=1:1 Q:$D(DIRUT) D PHIN Q:ESPNOT!($D(DTOUT))
QUIT
PHIN ;PROPERTY HELD INPUT
I $D(^TMP($J,"UOR","PH",ESPN)) D WARN I 'ESPNOT K ^TMP("UOR","PH")
QUIT:ESPNOT
W !!,"ITEM #",ESPN
NUM S DIR(0)="912.02,.01" D RD Q:$D(DIRUT) S ESPD(.01)=Y
QUAN S DIR(0)="912.02,.02" D RD G:$D(DUOUT) SPH G:$D(DTOUT) NOUPD S ESPD(.02)=Y
PUR S DIR(0)="912.02,.03" D RD G:$D(DUOUT) SPH G:$D(DTOUT) NOUPD S ESPD(.03)=Y
DESC W !,"Description: " S DWLW=80,DWPK=1,DIC="^TMP($J,""DE"","_ESPD(.01)_"," D EN^DIWE
I $D(DTOUT) S NOUPD=1 Q
SPH S ^TMP($J,"UOR","PH",ESPN)=ESPD(.01)_"^"_$G(ESPD(.02))_"^"_$G(ESPD(.03))
QUIT
EXIT QUIT
NO W $C(7),!!?5,"NO '^'S ALLOWED!",!!
QUIT
NOUPD W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPCL,ESPD,ESPDTR,ESPX,ESPY,^TMP($J) S NOUPD=1 QUIT
RD D ^DIR I $S($L(X)>1&($E(X)=U):1,($L(X)>1&(X[U)):1,1:0) D NO K X,Y G RD
K DIR
QUIT
WARN W !!,$C(7),"Warning: The names that you have previously entered will be replaced if you enter a name."
S DIR(0)="Y",DIR("A")="Are you sure you want to do this",DIR("B")="NO" D ^DIR K DIR
I 'Y S ESPNOT=1
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPSCR1 3917 printed Sep 23, 2025@20:06:41 Page 2
ESPSCR1 ;DALISC/CKA - OFFENSE REPORT SCREENS-NAMES & NARRATIVE;2/93
+1 ;;1.0;POLICE & SECURITY;**12**;Mar 31, 1994
EN ;CALLED FROM ESPOFF
QUIT
COMP ;COMPLAINANT SCREEN
+1 SET ESPNOT=0
+2 FOR ESPN=1:1
if '$DATA(ESPFN)&(ESPN'=1)!($DATA(DTOUT))
QUIT
Begin DoDot:1
+3 IF $DATA(^TMP($JOB,"UOR","C",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP($JOB,"UOR","C")
+4 if ESPNOT
QUIT
+5 WRITE !!,"COMPLAINANT #",ESPN
+6 KILL ESPFN
DO EN^ESPMNI
+7 IF $DATA(ESPFN)
IF (ESPFN>0)
SET ^TMP($JOB,"UOR","C",ESPN)=ESPFN
End DoDot:1
if ESPNOT
QUIT
+8 QUIT
VIC ;VICTIM SCREEN
+1 SET ESPNOT=0
+2 FOR ESPN=1:1
if '$DATA(ESPFN)&(ESPN'=1)!($DATA(DTOUT))
QUIT
Begin DoDot:1
+3 IF $DATA(^TMP($JOB,"UOR","V",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP($JOB,"UOR","V")
+4 if ESPNOT
QUIT
+5 WRITE !!,"VICTIM #",ESPN
+6 KILL ESPFN
DO EN^ESPMNI
+7 if $DATA(DTOUT)
QUIT
+8 IF $DATA(ESPFN)
IF (ESPFN>0)
SET ^TMP($JOB,"UOR","V",ESPN)=ESPFN
WRITE !,"MEDICAL TREATMENT: "
SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""MT"","_ESPN_","
SET DIWESUB="MEDICAL TREATMENT"
DO EN^DIWE
End DoDot:1
if ESPNOT
QUIT
+9 QUIT
WIT ;WITNESS SCREEN
+1 SET ESPNOT=0
+2 FOR ESPN=1:1
if '$DATA(ESPFN)&(ESPN'=1)!($DATA(DTOUT))
QUIT
Begin DoDot:1
+3 IF $DATA(^TMP($JOB,"UOR","W",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP($JOB,"UOR","W")
+4 if ESPNOT
QUIT
+5 WRITE !!,"WITNESS #",ESPN
+6 KILL ESPFN
DO EN^ESPMNI
+7 IF $DATA(ESPFN)
IF (ESPFN>0)
SET ^TMP($JOB,"UOR","W",ESPN)=ESPFN
End DoDot:1
if ESPNOT
QUIT
+8 QUIT
NARR ;NARRATIVE SCREEN
+1 WRITE !!,"ORIGIN:"
+2 SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""N1"","
SET DIWESUB="ORIGIN"
DO EN^DIWE
+3 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
+4 WRITE !!,"INITIAL OBSERVATION:"
+5 SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""N2"","
SET DIWESUB="INITIAL OBSERVATION"
DO EN^DIWE
+6 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
+7 WRITE !!,"INVESTIGATION:"
+8 SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""N3"","
SET DIWESUB="INVESTIGATION"
DO EN^DIWE
+9 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
+10 WRITE !!,"DISPOSITION:"
+11 SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""N4"","
SET DIWESUB="DISPOSITION"
DO EN^DIWE
+12 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
+13 QUIT
NOTIF ;NOTIFICATIONS SCREEN INPUT
+1 SET ESPNOT=0
KILL DIRUT
+2 FOR ESPN=1:1
if $DATA(DIRUT)
QUIT
DO OAN
if ESPNOT
QUIT
+3 if $DATA(DTOUT)
QUIT
+4 SET ESPNOT=0
KILL DIRUT
+5 FOR ESPN=1:1
if $DATA(DIRUT)
QUIT
DO ATY
if ESPNOT!($DATA(DTOUT))
QUIT
+6 QUIT
NOTIN ;NOTIFICATIONS INPUT
OAN ;OTHER AGENCY NOTIFIED
+1 IF $DATA(^TMP($JOB,"UOR","OTH",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP("UOR","OTH")
+2 if ESPNOT
QUIT
+3 WRITE !!,"OTHER AGENCY"
OAG SET DIR(0)="912.14,.01"
DO RD
if $DATA(DIRUT)
QUIT
SET ESPD(.01)=Y
CONT SET DIR(0)="912.14,.02"
DO RD
if $DATA(DUOUT)
GOTO SNO
if $DATA(DTOUT)
GOTO NOUPD
SET ESPD(.02)=Y
AG SET DIR(0)="912.14,.03"
DO RD
if $DATA(DUOUT)
GOTO SNO
if $DATA(DTOUT)
GOTO NOUPD
SET ESPD(.03)=Y
SNO SET ^TMP($JOB,"UOR","OTH",ESPN)=ESPD(.01)_"^"_$GET(ESPD(.02))_"^"_$GET(ESPD(.03))
+1 KILL DIRUT
+2 QUIT
ATY ;U.S. ATTORNEY NOTIFIED
+1 IF $DATA(^TMP($JOB,"UOR","ATY",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP("UOR","ATY")
+2 if ESPNOT
QUIT
+3 WRITE !!,"U.S. ATTORNEY"
+4 SET DIR(0)="912.15,.01"
DO RD
if $DATA(DIRUT)
QUIT
SET ESPD(.01)=Y
INSTR WRITE !,"Instructions Received: "
SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""INS"","_ESPN_","
SET DIWESUB="Instructions Received"
DO EN^DIWE
+1 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
+2 SET ^TMP($JOB,"UOR","ATY",ESPN)=ESPD(.01)_"^"
+3 QUIT
HELD ;PROPERTY (HELD) SCREEN INPUT
+1 SET ESPNOT=0
KILL DIRUT
+2 FOR ESPN=1:1
if $DATA(DIRUT)
QUIT
DO PHIN
if ESPNOT!($DATA(DTOUT))
QUIT
+3 QUIT
PHIN ;PROPERTY HELD INPUT
+1 IF $DATA(^TMP($JOB,"UOR","PH",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP("UOR","PH")
+2 if ESPNOT
QUIT
+3 WRITE !!,"ITEM #",ESPN
NUM SET DIR(0)="912.02,.01"
DO RD
if $DATA(DIRUT)
QUIT
SET ESPD(.01)=Y
QUAN SET DIR(0)="912.02,.02"
DO RD
if $DATA(DUOUT)
GOTO SPH
if $DATA(DTOUT)
GOTO NOUPD
SET ESPD(.02)=Y
PUR SET DIR(0)="912.02,.03"
DO RD
if $DATA(DUOUT)
GOTO SPH
if $DATA(DTOUT)
GOTO NOUPD
SET ESPD(.03)=Y
DESC WRITE !,"Description: "
SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""DE"","_ESPD(.01)_","
DO EN^DIWE
+1 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
SPH SET ^TMP($JOB,"UOR","PH",ESPN)=ESPD(.01)_"^"_$GET(ESPD(.02))_"^"_$GET(ESPD(.03))
+1 QUIT
EXIT QUIT
NO WRITE $CHAR(7),!!?5,"NO '^'S ALLOWED!",!!
+1 QUIT
NOUPD WRITE !!,$CHAR(7),?20,"NO UPDATING HAS OCCURRED!!!",!!
KILL ESPCL,ESPD,ESPDTR,ESPX,ESPY,^TMP($JOB)
SET NOUPD=1
QUIT
RD DO ^DIR
IF $SELECT($LENGTH(X)>1&($EXTRACT(X)=U):1,($LENGTH(X)>1&(X[U)):1,1:0)
DO NO
KILL X,Y
GOTO RD
+1 KILL DIR
+2 QUIT
WARN WRITE !!,$CHAR(7),"Warning: The names that you have previously entered will be replaced if you enter a name."
+1 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to do this"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+2 IF 'Y
SET ESPNOT=1
+3 QUIT
