source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPUCF.m@ 703

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

initial load of WorldVistAEHR

File size: 4.2 KB
RevLine 
[613]1ESPUCF ;DALISC/CKA - UNIFORM CRIME REPORT BY FACILITY- 3/99
2 ;;1.0;POLICE & SECURITY;**27,33,35**;Mar 31, 1994
3START ;
4 I '$D(DUZ(2)) W !,"Site # is not defined!" G EX
5DATE ;ASK BEGINNING & ENDING DATE
6 D DT^DICRW K BEGDATE,ENDDATE W !!,"**** Date Range Selection ****",!
7 S %DT="AE",%DT(0)="-NOW",%DT("A")=" Beginning DATE : " D ^%DT K %DT
8 G:Y<0 EX
9 S (BEGDATE,ESPBD)=Y
10 W ! S %DT="AE",%DT("A")=" Ending DATE: " D ^%DT
11 G:$D(DTOUT) EX
12 G:Y<ESPBD HELP W ! S ENDDATE=Y,ESPED=Y+.9
13CREATE ;CREATE A NEW ENTRY IN CRIME DATA FILE
14 K DD,DO S DIC="^ESP(912.3,",DIC(0)="L",DLAYGO=912.3,X=ESPBD D FILE^DICN G:Y<0 EX S ESPIEN=+Y
15 L +^ESP(912.3,ESPIEN):1 I '$T W !,"This record is being edited by someone else."
16 S $P(^ESP(912.3,ESPIEN,0),U,2)=ENDDATE
17 S:'$D(^ESP(912.3,ESPIEN,1,0)) ^(0)="^912.31^"
18COUNT ;GO THROUGH "C" X-REF TO COUNT AND GET TOTALS
19 S ESPDT=ESPBD-.0005
20 F ESPI=1:1 S ESPDT=$O(^ESP(912,"C",ESPDT)) Q:ESPDT>ESPED!(ESPDT'>0) D
21 .S ESPOFN=0
22 .F ESPJ=1:1 S ESPOFN=$O(^ESP(912,"C",ESPDT,ESPOFN)) Q:ESPOFN'>0 D
23 ..I $D(^ESP(912,ESPOFN,5)) Q:'$P(^ESP(912,ESPOFN,5),U,5)
24 ..S ESPINS=$P(^ESP(912,ESPOFN,0),U,7) Q:+ESPINS'>0
25 ..S DIC="40.8",DR="1",DA=+ESPINS,DIQ="STA",DIQ(0)="I" D EN^DIQ1
26 ..S STN=$G(STA(40.8,DA,DR,"I"))
27 ..K DA,DIC,DR,DIQ,STA
28 ..I '$D(^ESP(912.3,ESPIEN,1,ESPINS)) D
29 ...S ^ESP(912.3,ESPIEN,1,ESPINS,0)=ESPINS_"^"_STN
30 ...F ESPX=1:1:188 S ^ESP(912.3,ESPIEN,1,ESPINS,ESPX)=0
31 ...F ESPX=133.1,134.1,138.1,139.1 S ^ESP(912.3,ESPIEN,1,ESPINS,ESPX)=0
32 ..S ESPCN=0
33 ..F ESPZ=1:1 S ESPCN=$O(^ESP(912,ESPOFN,10,ESPCN)) Q:ESPCN'>0 D SET^ESPUCF1
34VIO ;GO THROUGH "C" X-REF VIOLATION FILE TO COUNT AND GET TOTALS
35 S ESPDT=ESPBD-.0005
36 F ESPI=1:1 S ESPDT=$O(^ESP(914,"C",ESPDT)) Q:ESPDT>ESPED!(ESPDT'>0) D
37 . S ESPOFN=0
38 . F ESPJ=1:1 S ESPOFN=$O(^ESP(914,"C",ESPDT,ESPOFN)) Q:ESPOFN'>0 D
39 .. S ESPINS=$P($G(^ESP(914,ESPOFN,0)),U,10) S:ESPINS="" ESPINS=$O(^DG(40.8,"C",$P($G(^ESP(914,ESPOFN,5)),U,1),"")) Q:ESPINS=""
40 .. S DIC=40.8,DR="1",DA=+ESPINS,DIQ="STA",DIQ(0)="I" D EN^DIQ1 S STN=$G(STA(40.8,DA,DR,"I")) K DA,DIC,DR,DIQ,STA
41 .. I '$D(^ESP(912.3,ESPIEN,1,ESPINS)) S ^ESP(912.3,ESPIEN,1,ESPINS,0)=ESPINS_"^"_STN
42 .. S ESPTYPE=$P(^ESP(914,ESPOFN,0),U,3),ESPOFF=$P(^(0),U,4),ESPCL=$P($G(^ESP(915,+ESPOFF,0)),U,4),ESPFN=$P(^ESP(914,ESPOFN,0),U,9),ESPCAT=$P($G(^ESP(910,+ESPFN,0)),U,4)
43 .. S ^ESP(912.3,ESPIEN,1,ESPINS,171)=$G(^ESP(912.3,ESPIEN,1,ESPINS,171))+1
44 .. I ESPTYPE="C" S ^ESP(912.3,ESPIEN,1,ESPINS,172)=$G(^ESP(912.3,ESPIEN,1,ESPINS,172))+1 D
45 ... I ESPCL'="M",ESPCL'="P" S ^ESP(912.3,ESPIEN,1,ESPINS,173)=$G(^ESP(912.3,ESPIEN,1,ESPINS,173))+1
46 ... I ESPCL="M" S ^ESP(912.3,ESPIEN,1,ESPINS,174)=$G(^ESP(912.3,ESPIEN,1,ESPINS,174))+1
47 ... I ESPCL="P" S ^ESP(912.3,ESPIEN,1,ESPINS,175)=$G(^ESP(912.3,ESPIEN,1,ESPINS,175))+1
48 ... I ESPCAT="E"!(ESPCAT="PO") S ^ESP(912.3,ESPIEN,1,ESPINS,176)=$G(^ESP(912.3,ESPIEN,1,ESPINS,176))+1
49 ... I ESPCAT="O"!(ESPCAT="") S ^ESP(912.3,ESPIEN,1,ESPINS,177)=$G(^ESP(912.3,ESPIEN,1,ESPINS,177))+1
50 ... I ESPCAT="P" S ^ESP(912.3,ESPIEN,1,ESPINS,178)=$G(^ESP(912.3,ESPIEN,1,ESPINS,178))+1
51 ... I ESPCAT="V" S ^ESP(912.3,ESPIEN,1,ESPINS,179)=$G(^ESP(912.3,ESPIEN,1,ESPINS,179))+1
52 .. I ESPTYPE="V" S ^ESP(912.3,ESPIEN,1,ESPINS,180)=$G(^ESP(912.3,ESPIEN,1,ESPINS,180))+1 D
53 ... I ESPCL'="M",ESPCL'="P" S ^ESP(912.3,ESPIEN,1,ESPINS,181)=$G(^ESP(912.3,ESPIEN,1,ESPINS,181))+1
54 ... I ESPCL="M" S ^ESP(912.3,ESPIEN,1,ESPINS,182)=$G(^ESP(912.3,ESPIEN,1,ESPINS,182))+1
55 ... I ESPCL="P" S ^ESP(912.3,ESPIEN,1,ESPINS,183)=$G(^ESP(912.3,ESPIEN,1,ESPINS,183))+1
56 ... I ESPCAT="E"!(ESPCAT="PO") S ^ESP(912.3,ESPIEN,1,ESPINS,184)=$G(^ESP(912.3,ESPIEN,1,ESPINS,184))+1
57 ... I ESPCAT="O"!(ESPCAT="") S ^ESP(912.3,ESPIEN,1,ESPINS,185)=$G(^ESP(912.3,ESPIEN,1,ESPINS,185))+1
58 ... I ESPCAT="P" S ^ESP(912.3,ESPIEN,1,ESPINS,186)=$G(^ESP(912.3,ESPIEN,1,ESPINS,186))+1
59 ... I ESPCAT="V" S ^ESP(912.3,ESPIEN,1,ESPINS,187)=$G(^ESP(912.3,ESPIEN,1,ESPINS,187))+1
60 K STN
61 L -^ESP(912.3,ESPIEN)
62 W !!,"Done."
63XREF ;
64 N DIK,DIR,X,Y,DA,DIE,DIC
65 S DIK="^ESP(912.3,",DA=ESPIEN
66 D IX1^DIK
67EX W:$D(DTOUT) $C(7)
68 K %DT,BEGDATE,DA,DD,DIC,DO,DTOUT,ENDDATE,ESPBD,ESPCAT,ESPCC,ESPCL,ESPCN,ESPDOL,ESPDT,ESPED,ESPFN,ESPI,ESPIEN,ESPINS,ESPJ,ESPOF,ESPOFF,ESPOFN,ESPSUB,ESPTYPE,ESPVIC,ESPVICT,ESPX,ESPZ,X,Y
69 QUIT
70 ;
71HELP W "??",!?5,"Ending date must not be before beginning date" G DATE
Note: See TracBrowser for help on using the repository browser.