- 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 Feb 18, 2025@23:56:49 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