ESPSCR ;DALISC/CKA - OFFENSE REPORT SCREENS;8/92
;;1.0;POLICE & SECURITY;;Mar 31, 1994
EN ;
OFFE ;OFFENDER SCREEN INPUT
S ESPNOT=0
F ESPN=1:1 Q:'$D(ESPFN)&(ESPN'=1)!($D(DTOUT)) D OFIN Q:ESPNOT
QUIT
OFIN I $D(^TMP($J,"UOR","O",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","O")
Q:ESPNOT S ESPTEST=""
W !!,"OFFENDER #",ESPN
K ESPFN D EN^ESPMNI
I $D(DTOUT) S NOUPD=1 Q
S ESPNO=0 I '$D(ESPFN) D DESCR
I $D(DTOUT) S NOUPD=1 Q
PERS I 'ESPNO S DIR(0)="912.05,3.01" D RD G:$D(DTOUT) NOUPD G:$D(DUOUT) SO S ESPD(3.01)=Y
SO F ESPX=.04:.01:.1 S ESPTEST=ESPTEST_$G(ESPD(ESPX))
QUIT:'$D(ESPFN)&(ESPTEST="")&($G(ESPD(3.01))="")
S ^TMP($J,"UOR","O",ESPN)=$G(ESPFN)_"^^^"_$G(ESPD(.04))_"^"_$G(ESPD(.05))_"^"_$G(ESPD(.06))_"^"_$G(ESPD(.07))_"^"_$G(ESPD(.08))_"^"_$G(ESPD(.09))_"^"_$G(ESPD(.1)),^TMP($J,"UOR","OPERS",ESPN)=$G(ESPD(3.01))_"^"
K ESPD S ESPI=1
OFF S DIR(0)="912.11,.01" D RD Q:$D(DIRUT) S ESPOFF(ESPI)=+Y
DISP S DIR(0)="912.11,.02" D RD G:$D(DUOUT) SOF G:$D(DTOUT) NOUPD S ESPDISP(ESPI)=+Y
S CHD(ESPI)=""
CHD I ESPDISP(ESPI)=1 S DIR(0)="912.11,.04" D RD G:$D(DUOUT) SOF G:$D(DTOUT) NOUPD S CHD(ESPI)=Y
SOF S ^TMP($J,"UOR","O",ESPN,ESPI,0)=ESPOFF(ESPI)_"^"_$G(ESPDISP(ESPI))_"^^"_$G(CHD(ESPI))
YN S DIR(0)="Y",DIR("A")="Do you want to enter another offense for this offender",DIR("B")="NO" D ^DIR K DIR
G:$D(DTOUT) NOUPD
I "01"'[Y W !!,$C(7),?5,"You must enter Yes or No." G YN
I Y S ESPI=ESPI+1 G OFF
QUIT
EXIT K ESPNO,ESPTEST,X,Y
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
DESCR ;Enter unknown offender description
S DIR(0)="Y",DIR("A")="Do you wish to enter an unknown offender description",DIR("B")="NO" D ^DIR K DIR
G:$D(DTOUT) NOUPD
I 'Y S ESPNO=1 QUIT
W !!,"UNKNOWN OFFENDER DESCRIPTION"
RACE S DIR(0)="912.05,.04" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.04)=$P(Y,U)
HGHT S DIR(0)="912.05,.05" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.05)=Y
WGHT S DIR(0)="912.05,.06" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.06)=Y
HAIR S DIR(0)="912.05,.07" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.07)=$P(Y,U)
EYE S DIR(0)="912.05,.08" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.08)=$P(Y,U)
SKIN S DIR(0)="912.05,.09" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.09)=$P(Y,U)
SCAR S DIR(0)="912.05,.1" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.1)=Y
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[HESPSCR 2708 printed Apr 09, 2024@21:33:18 Page 2
ESPSCR ;DALISC/CKA - OFFENSE REPORT SCREENS;8/92
+1 ;;1.0;POLICE & SECURITY;;Mar 31, 1994
EN ;
OFFE ;OFFENDER SCREEN INPUT
+1 SET ESPNOT=0
+2 FOR ESPN=1:1
if '$DATA(ESPFN)&(ESPN'=1)!($DATA(DTOUT))
QUIT
DO OFIN
if ESPNOT
QUIT
+3 QUIT
OFIN IF $DATA(^TMP($JOB,"UOR","O",ESPN))
DO WARN
IF 'ESPNOT
KILL ^TMP($JOB,"UOR","O")
+1 if ESPNOT
QUIT
SET ESPTEST=""
+2 WRITE !!,"OFFENDER #",ESPN
+3 KILL ESPFN
DO EN^ESPMNI
+4 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
+5 SET ESPNO=0
IF '$DATA(ESPFN)
DO DESCR
+6 IF $DATA(DTOUT)
SET NOUPD=1
QUIT
PERS IF 'ESPNO
SET DIR(0)="912.05,3.01"
DO RD
if $DATA(DTOUT)
GOTO NOUPD
if $DATA(DUOUT)
GOTO SO
SET ESPD(3.01)=Y
SO FOR ESPX=.04:.01:.1
SET ESPTEST=ESPTEST_$GET(ESPD(ESPX))
+1 if '$DATA(ESPFN)&(ESPTEST="")&($GET(ESPD(3.01))="")
QUIT
+2 SET ^TMP($JOB,"UOR","O",ESPN)=$GET(ESPFN)_"^^^"_$GET(ESPD(.04))_"^"_$GET(ESPD(.05))_"^"_$GET(ESPD(.06))_"^"_$GET(ESPD(.07))_"^"_$GET(ESPD(.08))_"^"_$GET(ESPD(.09))_"^"_$GET(ESPD(.1))
SET ^TMP($JOB,"UOR","OPERS",ESPN)=$GET(ESPD(3.01))_"^"
+3 KILL ESPD
SET ESPI=1
OFF SET DIR(0)="912.11,.01"
DO RD
if $DATA(DIRUT)
QUIT
SET ESPOFF(ESPI)=+Y
DISP SET DIR(0)="912.11,.02"
DO RD
if $DATA(DUOUT)
GOTO SOF
if $DATA(DTOUT)
GOTO NOUPD
SET ESPDISP(ESPI)=+Y
+1 SET CHD(ESPI)=""
CHD IF ESPDISP(ESPI)=1
SET DIR(0)="912.11,.04"
DO RD
if $DATA(DUOUT)
GOTO SOF
if $DATA(DTOUT)
GOTO NOUPD
SET CHD(ESPI)=Y
SOF SET ^TMP($JOB,"UOR","O",ESPN,ESPI,0)=ESPOFF(ESPI)_"^"_$GET(ESPDISP(ESPI))_"^^"_$GET(CHD(ESPI))
YN SET DIR(0)="Y"
SET DIR("A")="Do you want to enter another offense for this offender"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+1 if $DATA(DTOUT)
GOTO NOUPD
+2 IF "01"'[Y
WRITE !!,$CHAR(7),?5,"You must enter Yes or No."
GOTO YN
+3 IF Y
SET ESPI=ESPI+1
GOTO OFF
+4 QUIT
EXIT KILL ESPNO,ESPTEST,X,Y
+1 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
DESCR ;Enter unknown offender description
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to enter an unknown offender description"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+2 if $DATA(DTOUT)
GOTO NOUPD
+3 IF 'Y
SET ESPNO=1
QUIT
+4 WRITE !!,"UNKNOWN OFFENDER DESCRIPTION"
RACE SET DIR(0)="912.05,.04"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.04)=$PIECE(Y,U)
HGHT SET DIR(0)="912.05,.05"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.05)=Y
WGHT SET DIR(0)="912.05,.06"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.06)=Y
HAIR SET DIR(0)="912.05,.07"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.07)=$PIECE(Y,U)
EYE SET DIR(0)="912.05,.08"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.08)=$PIECE(Y,U)
SKIN SET DIR(0)="912.05,.09"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.09)=$PIECE(Y,U)
SCAR SET DIR(0)="912.05,.1"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
SET ESPD(.1)=Y
+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
