- ESPSCR0 ;DALISC/CKA - OFFENSE REPORT SCREENS- CONTINUED;7/93
- ;;1.0;POLICE & SECURITY;;Mar 31, 1994
- EN ;
- VEH ;VEHICLE SCREEN INPUT
- S ESPNOT=0 K DIRUT
- F ESPN=1:1 D VEIN Q:ESPNOT!($D(DUOUT))!($D(DTOUT))
- QUIT
- VEIN ;VEHICLE INFO INPUT
- I $D(^TMP($J,"UOR","VE",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","VE")
- QUIT:ESPNOT W !
- S DIR(0)="Y",DIR("A")="Do you want to enter Vehicle #"_ESPN_" Information",DIR("B")="NO" D ^DIR K DIR
- I 'Y S ESPNOT=1 Q
- W !!,"VEHICLE #",ESPN
- TAG W ! S DIR(0)="912.09,.02" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.02)=Y
- VST S DIR(0)="912.09,.03" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.03)=$P(Y,U)
- MAKE S DIR(0)="912.09,.04" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.04)=$P(Y,U)
- MOD S DIR(0)="912.09,.05" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.05)=Y
- STY S DIR(0)="912.09,.06" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.06)=Y
- COL S DIR(0)="912.09,.07" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.07)=$P(Y,U)
- DEC S DIR(0)="912.09,.08" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.08)=$P(Y,U)
- DCOL S DIR(0)="912.09,.09" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.09)=$P(Y,U)
- YR S DIR(0)="912.09,.1" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.1)=Y
- OWN S DIR(0)="912.09,.11" D RD G:$D(DUOUT) SV S ESPD(.11)=$P(Y,U)
- SV S ^TMP($J,"UOR","VE",ESPN)=ESPN_"^"_$G(ESPD(.02))_"^"_$G(ESPD(.03))_"^"_$G(ESPD(.04))_"^"_$G(ESPD(.05))_"^"_$G(ESPD(.06))_"^"_$G(ESPD(.07))_"^"_$G(ESPD(.08))_"^"_$G(ESPD(.09))_"^"_$G(ESPD(.1))_"^"_$G(ESPD(.11)) K ESPD
- QUIT
- PROP ;PROPERTY (LOST) SCREEN INPUT
- S ESPNOT=0 K DIRUT
- F ESPN=1:1 D LPIN Q:ESPNOT!($D(DTOUT))!($D(DUOUT))
- QUIT
- LPIN ;LOST PROPERTY INPUT
- I $D(^TMP($J,"UOR","P",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","P")
- QUIT:ESPNOT
- W !!,"ITEM #",ESPN
- NAM S DIR(0)="912.1,.01" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT)) S ESPD(.01)=Y
- I ESPD(.01)']"" S ESPNOT=1 Q
- I $D(^TMP($J,"UOR","P",ESPD(.01))) W !,$C(7),"There is already an item named ",ESPD(.01),". Please enter another name." G NAM
- LDESC S DIR(0)="912.1,.02" D RD G:$D(DUOUT) SPR G:$D(DTOUT) NOUPD S ESPD(.02)=Y
- VAL S DIR(0)="912.1,.03" D RD G:$D(DUOUT) SPR G:$D(DTOUT) NOUPD S ESPD(.03)=Y
- REC S DIR(0)="912.1,.04" D RD G:$D(DUOUT) SPR G:$D(DTOUT) NOUPD S ESPD(.04)=Y
- SPR S ^TMP($J,"UOR","P",ESPD(.01))=ESPD(.01)_"^"_$G(ESPD(.02))_"^"_$G(ESPD(.03))_"^"_$G(ESPD(.04)) K ESPD
- 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
- 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[HESPSCR0 2852 printed Feb 18, 2025@23:56:50 Page 2
- ESPSCR0 ;DALISC/CKA - OFFENSE REPORT SCREENS- CONTINUED;7/93
- +1 ;;1.0;POLICE & SECURITY;;Mar 31, 1994
- EN ;
- VEH ;VEHICLE SCREEN INPUT
- +1 SET ESPNOT=0
- KILL DIRUT
- +2 FOR ESPN=1:1
- DO VEIN
- if ESPNOT!($DATA(DUOUT))!($DATA(DTOUT))
- QUIT
- +3 QUIT
- VEIN ;VEHICLE INFO INPUT
- +1 IF $DATA(^TMP($JOB,"UOR","VE",ESPN))
- DO WARN
- IF 'ESPNOT
- KILL ^TMP($JOB,"UOR","VE")
- +2 if ESPNOT
- QUIT
- WRITE !
- +3 SET DIR(0)="Y"
- SET DIR("A")="Do you want to enter Vehicle #"_ESPN_" Information"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +4 IF 'Y
- SET ESPNOT=1
- QUIT
- +5 WRITE !!,"VEHICLE #",ESPN
- TAG WRITE !
- SET DIR(0)="912.09,.02"
- DO RD
- if $DATA(DUOUT)!($DATA(DTOUT))
- QUIT
- SET ESPD(.02)=Y
- VST SET DIR(0)="912.09,.03"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.03)=$PIECE(Y,U)
- MAKE SET DIR(0)="912.09,.04"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.04)=$PIECE(Y,U)
- MOD SET DIR(0)="912.09,.05"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.05)=Y
- STY SET DIR(0)="912.09,.06"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.06)=Y
- COL SET DIR(0)="912.09,.07"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.07)=$PIECE(Y,U)
- DEC SET DIR(0)="912.09,.08"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.08)=$PIECE(Y,U)
- DCOL SET DIR(0)="912.09,.09"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.09)=$PIECE(Y,U)
- YR SET DIR(0)="912.09,.1"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.1)=Y
- OWN SET DIR(0)="912.09,.11"
- DO RD
- if $DATA(DUOUT)
- GOTO SV
- SET ESPD(.11)=$PIECE(Y,U)
- SV SET ^TMP($JOB,"UOR","VE",ESPN)=ESPN_"^"_$GET(ESPD(.02))_"^"_$GET(ESPD(.03))_"^"_$GET(ESPD(.04))_"^"_$GET(ESPD(.05))_"^"_$GET(ESPD(.06))_"^"_$GET(ESPD(.07))_"^"_$GET(ESPD(.08))_"^"_$GET(ESPD(.09))_"^"_$GET(ESPD(.1))_"^"_$GET(ESPD(.11))
- KILL ESPD
- +1 QUIT
- PROP ;PROPERTY (LOST) SCREEN INPUT
- +1 SET ESPNOT=0
- KILL DIRUT
- +2 FOR ESPN=1:1
- DO LPIN
- if ESPNOT!($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +3 QUIT
- LPIN ;LOST PROPERTY INPUT
- +1 IF $DATA(^TMP($JOB,"UOR","P",ESPN))
- DO WARN
- IF 'ESPNOT
- KILL ^TMP($JOB,"UOR","P")
- +2 if ESPNOT
- QUIT
- +3 WRITE !!,"ITEM #",ESPN
- NAM SET DIR(0)="912.1,.01"
- DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- SET ESPD(.01)=Y
- +1 IF ESPD(.01)']""
- SET ESPNOT=1
- QUIT
- +2 IF $DATA(^TMP($JOB,"UOR","P",ESPD(.01)))
- WRITE !,$CHAR(7),"There is already an item named ",ESPD(.01),". Please enter another name."
- GOTO NAM
- LDESC SET DIR(0)="912.1,.02"
- DO RD
- if $DATA(DUOUT)
- GOTO SPR
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.02)=Y
- VAL SET DIR(0)="912.1,.03"
- DO RD
- if $DATA(DUOUT)
- GOTO SPR
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.03)=Y
- REC SET DIR(0)="912.1,.04"
- DO RD
- if $DATA(DUOUT)
- GOTO SPR
- if $DATA(DTOUT)
- GOTO NOUPD
- SET ESPD(.04)=Y
- SPR SET ^TMP($JOB,"UOR","P",ESPD(.01))=ESPD(.01)_"^"_$GET(ESPD(.02))_"^"_$GET(ESPD(.03))_"^"_$GET(ESPD(.04))
- KILL ESPD
- +1 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
- 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