source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPSCR0.m@ 1476

Last change on this file since 1476 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1ESPSCR0 ;DALISC/CKA - OFFENSE REPORT SCREENS- CONTINUED;7/93
2 ;;1.0;POLICE & SECURITY;;Mar 31, 1994
3EN ;
4VEH ;VEHICLE SCREEN INPUT
5 S ESPNOT=0 K DIRUT
6 F ESPN=1:1 D VEIN Q:ESPNOT!($D(DUOUT))!($D(DTOUT))
7 QUIT
8VEIN ;VEHICLE INFO INPUT
9 I $D(^TMP($J,"UOR","VE",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","VE")
10 QUIT:ESPNOT W !
11 S DIR(0)="Y",DIR("A")="Do you want to enter Vehicle #"_ESPN_" Information",DIR("B")="NO" D ^DIR K DIR
12 I 'Y S ESPNOT=1 Q
13 W !!,"VEHICLE #",ESPN
14TAG W ! S DIR(0)="912.09,.02" D RD Q:$D(DUOUT)!($D(DTOUT)) S ESPD(.02)=Y
15VST S DIR(0)="912.09,.03" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.03)=$P(Y,U)
16MAKE S DIR(0)="912.09,.04" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.04)=$P(Y,U)
17MOD S DIR(0)="912.09,.05" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.05)=Y
18STY S DIR(0)="912.09,.06" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.06)=Y
19COL S DIR(0)="912.09,.07" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.07)=$P(Y,U)
20DEC S DIR(0)="912.09,.08" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.08)=$P(Y,U)
21DCOL S DIR(0)="912.09,.09" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.09)=$P(Y,U)
22YR S DIR(0)="912.09,.1" D RD G:$D(DUOUT) SV G:$D(DTOUT) NOUPD S ESPD(.1)=Y
23OWN S DIR(0)="912.09,.11" D RD G:$D(DUOUT) SV S ESPD(.11)=$P(Y,U)
24SV 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
25 QUIT
26PROP ;PROPERTY (LOST) SCREEN INPUT
27 S ESPNOT=0 K DIRUT
28 F ESPN=1:1 D LPIN Q:ESPNOT!($D(DTOUT))!($D(DUOUT))
29 QUIT
30LPIN ;LOST PROPERTY INPUT
31 I $D(^TMP($J,"UOR","P",ESPN)) D WARN I 'ESPNOT K ^TMP($J,"UOR","P")
32 QUIT:ESPNOT
33 W !!,"ITEM #",ESPN
34NAM S DIR(0)="912.1,.01" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT)) S ESPD(.01)=Y
35 I ESPD(.01)']"" S ESPNOT=1 Q
36 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
37LDESC S DIR(0)="912.1,.02" D RD G:$D(DUOUT) SPR G:$D(DTOUT) NOUPD S ESPD(.02)=Y
38VAL S DIR(0)="912.1,.03" D RD G:$D(DUOUT) SPR G:$D(DTOUT) NOUPD S ESPD(.03)=Y
39REC S DIR(0)="912.1,.04" D RD G:$D(DUOUT) SPR G:$D(DTOUT) NOUPD S ESPD(.04)=Y
40SPR S ^TMP($J,"UOR","P",ESPD(.01))=ESPD(.01)_"^"_$G(ESPD(.02))_"^"_$G(ESPD(.03))_"^"_$G(ESPD(.04)) K ESPD
41 QUIT
42EXIT K ESPNO,ESPTEST,X,Y
43 QUIT
44NO W $C(7),!!?5,"NO '^'S ALLOWED!",!!
45 QUIT
46NOUPD W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPCL,ESPD,ESPDTR,ESPX,ESPY,^TMP($J) S NOUPD=1 QUIT
47RD 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
48 K DIR
49 QUIT
50WARN W !!,$C(7),"Warning: The names that you have previously entered will be replaced if you enter a name."
51 S DIR(0)="Y",DIR("A")="Are you sure you want to do this",DIR("B")="NO" D ^DIR K DIR
52 I 'Y S ESPNOT=1
53 QUIT
Note: See TracBrowser for help on using the repository browser.