ESPUCF ;DALISC/CKA - UNIFORM CRIME REPORT BY FACILITY- 3/99
;;1.0;POLICE & SECURITY;**27,33,35**;Mar 31, 1994
START ;
I '$D(DUZ(2)) W !,"Site # is not defined!" G EX
DATE ;ASK BEGINNING & ENDING DATE
D DT^DICRW K BEGDATE,ENDDATE W !!,"**** Date Range Selection ****",!
S %DT="AE",%DT(0)="-NOW",%DT("A")=" Beginning DATE : " D ^%DT K %DT
G:Y<0 EX
S (BEGDATE,ESPBD)=Y
W ! S %DT="AE",%DT("A")=" Ending DATE: " D ^%DT
G:$D(DTOUT) EX
G:Y<ESPBD HELP W ! S ENDDATE=Y,ESPED=Y+.9
CREATE ;CREATE A NEW ENTRY IN CRIME DATA FILE
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
L +^ESP(912.3,ESPIEN):1 I '$T W !,"This record is being edited by someone else."
S $P(^ESP(912.3,ESPIEN,0),U,2)=ENDDATE
S:'$D(^ESP(912.3,ESPIEN,1,0)) ^(0)="^912.31^"
COUNT ;GO THROUGH "C" X-REF TO COUNT AND GET TOTALS
S ESPDT=ESPBD-.0005
F ESPI=1:1 S ESPDT=$O(^ESP(912,"C",ESPDT)) Q:ESPDT>ESPED!(ESPDT'>0) D
.S ESPOFN=0
.F ESPJ=1:1 S ESPOFN=$O(^ESP(912,"C",ESPDT,ESPOFN)) Q:ESPOFN'>0 D
..I $D(^ESP(912,ESPOFN,5)) Q:'$P(^ESP(912,ESPOFN,5),U,5)
..S ESPINS=$P(^ESP(912,ESPOFN,0),U,7) Q:+ESPINS'>0
..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
..I '$D(^ESP(912.3,ESPIEN,1,ESPINS)) D
...S ^ESP(912.3,ESPIEN,1,ESPINS,0)=ESPINS_"^"_STN
...F ESPX=1:1:188 S ^ESP(912.3,ESPIEN,1,ESPINS,ESPX)=0
...F ESPX=133.1,134.1,138.1,139.1 S ^ESP(912.3,ESPIEN,1,ESPINS,ESPX)=0
..S ESPCN=0
..F ESPZ=1:1 S ESPCN=$O(^ESP(912,ESPOFN,10,ESPCN)) Q:ESPCN'>0 D SET^ESPUCF1
VIO ;GO THROUGH "C" X-REF VIOLATION FILE TO COUNT AND GET TOTALS
S ESPDT=ESPBD-.0005
F ESPI=1:1 S ESPDT=$O(^ESP(914,"C",ESPDT)) Q:ESPDT>ESPED!(ESPDT'>0) D
. S ESPOFN=0
. F ESPJ=1:1 S ESPOFN=$O(^ESP(914,"C",ESPDT,ESPOFN)) Q:ESPOFN'>0 D
.. 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=""
.. 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
.. I '$D(^ESP(912.3,ESPIEN,1,ESPINS)) S ^ESP(912.3,ESPIEN,1,ESPINS,0)=ESPINS_"^"_STN
.. 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)
.. S ^ESP(912.3,ESPIEN,1,ESPINS,171)=$G(^ESP(912.3,ESPIEN,1,ESPINS,171))+1
.. I ESPTYPE="C" S ^ESP(912.3,ESPIEN,1,ESPINS,172)=$G(^ESP(912.3,ESPIEN,1,ESPINS,172))+1 D
... I ESPCL'="M",ESPCL'="P" S ^ESP(912.3,ESPIEN,1,ESPINS,173)=$G(^ESP(912.3,ESPIEN,1,ESPINS,173))+1
... I ESPCL="M" S ^ESP(912.3,ESPIEN,1,ESPINS,174)=$G(^ESP(912.3,ESPIEN,1,ESPINS,174))+1
... I ESPCL="P" S ^ESP(912.3,ESPIEN,1,ESPINS,175)=$G(^ESP(912.3,ESPIEN,1,ESPINS,175))+1
... I ESPCAT="E"!(ESPCAT="PO") S ^ESP(912.3,ESPIEN,1,ESPINS,176)=$G(^ESP(912.3,ESPIEN,1,ESPINS,176))+1
... I ESPCAT="O"!(ESPCAT="") S ^ESP(912.3,ESPIEN,1,ESPINS,177)=$G(^ESP(912.3,ESPIEN,1,ESPINS,177))+1
... I ESPCAT="P" S ^ESP(912.3,ESPIEN,1,ESPINS,178)=$G(^ESP(912.3,ESPIEN,1,ESPINS,178))+1
... I ESPCAT="V" S ^ESP(912.3,ESPIEN,1,ESPINS,179)=$G(^ESP(912.3,ESPIEN,1,ESPINS,179))+1
.. I ESPTYPE="V" S ^ESP(912.3,ESPIEN,1,ESPINS,180)=$G(^ESP(912.3,ESPIEN,1,ESPINS,180))+1 D
... I ESPCL'="M",ESPCL'="P" S ^ESP(912.3,ESPIEN,1,ESPINS,181)=$G(^ESP(912.3,ESPIEN,1,ESPINS,181))+1
... I ESPCL="M" S ^ESP(912.3,ESPIEN,1,ESPINS,182)=$G(^ESP(912.3,ESPIEN,1,ESPINS,182))+1
... I ESPCL="P" S ^ESP(912.3,ESPIEN,1,ESPINS,183)=$G(^ESP(912.3,ESPIEN,1,ESPINS,183))+1
... I ESPCAT="E"!(ESPCAT="PO") S ^ESP(912.3,ESPIEN,1,ESPINS,184)=$G(^ESP(912.3,ESPIEN,1,ESPINS,184))+1
... I ESPCAT="O"!(ESPCAT="") S ^ESP(912.3,ESPIEN,1,ESPINS,185)=$G(^ESP(912.3,ESPIEN,1,ESPINS,185))+1
... I ESPCAT="P" S ^ESP(912.3,ESPIEN,1,ESPINS,186)=$G(^ESP(912.3,ESPIEN,1,ESPINS,186))+1
... I ESPCAT="V" S ^ESP(912.3,ESPIEN,1,ESPINS,187)=$G(^ESP(912.3,ESPIEN,1,ESPINS,187))+1
K STN
L -^ESP(912.3,ESPIEN)
W !!,"Done."
XREF ;
N DIK,DIR,X,Y,DA,DIE,DIC
S DIK="^ESP(912.3,",DA=ESPIEN
D IX1^DIK
EX W:$D(DTOUT) $C(7)
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
QUIT
;
HELP W "??",!?5,"Ending date must not be before beginning date" G DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPUCF 4390 printed Nov 22, 2024@17:40:24 Page 2
ESPUCF ;DALISC/CKA - UNIFORM CRIME REPORT BY FACILITY- 3/99
+1 ;;1.0;POLICE & SECURITY;**27,33,35**;Mar 31, 1994
START ;
+1 IF '$DATA(DUZ(2))
WRITE !,"Site # is not defined!"
GOTO EX
DATE ;ASK BEGINNING & ENDING DATE
+1 DO DT^DICRW
KILL BEGDATE,ENDDATE
WRITE !!,"**** Date Range Selection ****",!
+2 SET %DT="AE"
SET %DT(0)="-NOW"
SET %DT("A")=" Beginning DATE : "
DO ^%DT
KILL %DT
+3 if Y<0
GOTO EX
+4 SET (BEGDATE,ESPBD)=Y
+5 WRITE !
SET %DT="AE"
SET %DT("A")=" Ending DATE: "
DO ^%DT
+6 if $DATA(DTOUT)
GOTO EX
+7 if Y<ESPBD
GOTO HELP
WRITE !
SET ENDDATE=Y
SET ESPED=Y+.9
CREATE ;CREATE A NEW ENTRY IN CRIME DATA FILE
+1 KILL DD,DO
SET DIC="^ESP(912.3,"
SET DIC(0)="L"
SET DLAYGO=912.3
SET X=ESPBD
DO FILE^DICN
if Y<0
GOTO EX
SET ESPIEN=+Y
+2 LOCK +^ESP(912.3,ESPIEN):1
IF '$TEST
WRITE !,"This record is being edited by someone else."
+3 SET $PIECE(^ESP(912.3,ESPIEN,0),U,2)=ENDDATE
+4 if '$DATA(^ESP(912.3,ESPIEN,1,0))
SET ^(0)="^912.31^"
COUNT ;GO THROUGH "C" X-REF TO COUNT AND GET TOTALS
+1 SET ESPDT=ESPBD-.0005
+2 FOR ESPI=1:1
SET ESPDT=$ORDER(^ESP(912,"C",ESPDT))
if ESPDT>ESPED!(ESPDT'>0)
QUIT
Begin DoDot:1
+3 SET ESPOFN=0
+4 FOR ESPJ=1:1
SET ESPOFN=$ORDER(^ESP(912,"C",ESPDT,ESPOFN))
if ESPOFN'>0
QUIT
Begin DoDot:2
+5 IF $DATA(^ESP(912,ESPOFN,5))
if '$PIECE(^ESP(912,ESPOFN,5),U,5)
QUIT
+6 SET ESPINS=$PIECE(^ESP(912,ESPOFN,0),U,7)
if +ESPINS'>0
QUIT
+7 SET DIC="40.8"
SET DR="1"
SET DA=+ESPINS
SET DIQ="STA"
SET DIQ(0)="I"
DO EN^DIQ1
+8 SET STN=$GET(STA(40.8,DA,DR,"I"))
+9 KILL DA,DIC,DR,DIQ,STA
+10 IF '$DATA(^ESP(912.3,ESPIEN,1,ESPINS))
Begin DoDot:3
+11 SET ^ESP(912.3,ESPIEN,1,ESPINS,0)=ESPINS_"^"_STN
+12 FOR ESPX=1:1:188
SET ^ESP(912.3,ESPIEN,1,ESPINS,ESPX)=0
+13 FOR ESPX=133.1,134.1,138.1,139.1
SET ^ESP(912.3,ESPIEN,1,ESPINS,ESPX)=0
End DoDot:3
+14 SET ESPCN=0
+15 FOR ESPZ=1:1
SET ESPCN=$ORDER(^ESP(912,ESPOFN,10,ESPCN))
if ESPCN'>0
QUIT
DO SET^ESPUCF1
End DoDot:2
End DoDot:1
VIO ;GO THROUGH "C" X-REF VIOLATION FILE TO COUNT AND GET TOTALS
+1 SET ESPDT=ESPBD-.0005
+2 FOR ESPI=1:1
SET ESPDT=$ORDER(^ESP(914,"C",ESPDT))
if ESPDT>ESPED!(ESPDT'>0)
QUIT
Begin DoDot:1
+3 SET ESPOFN=0
+4 FOR ESPJ=1:1
SET ESPOFN=$ORDER(^ESP(914,"C",ESPDT,ESPOFN))
if ESPOFN'>0
QUIT
Begin DoDot:2
+5 SET ESPINS=$PIECE($GET(^ESP(914,ESPOFN,0)),U,10)
if ESPINS=""
SET ESPINS=$ORDER(^DG(40.8,"C",$PIECE($GET(^ESP(914,ESPOFN,5)),U,1),""))
if ESPINS=""
QUIT
+6 SET DIC=40.8
SET DR="1"
SET DA=+ESPINS
SET DIQ="STA"
SET DIQ(0)="I"
DO EN^DIQ1
SET STN=$GET(STA(40.8,DA,DR,"I"))
KILL DA,DIC,DR,DIQ,STA
+7 IF '$DATA(^ESP(912.3,ESPIEN,1,ESPINS))
SET ^ESP(912.3,ESPIEN,1,ESPINS,0)=ESPINS_"^"_STN
+8 SET ESPTYPE=$PIECE(^ESP(914,ESPOFN,0),U,3)
SET ESPOFF=$PIECE(^(0),U,4)
SET ESPCL=$PIECE($GET(^ESP(915,+ESPOFF,0)),U,4)
SET ESPFN=$PIECE(^ESP(914,ESPOFN,0),U,9)
SET ESPCAT=$PIECE($GET(^ESP(910,+ESPFN,0)),U,4)
+9 SET ^ESP(912.3,ESPIEN,1,ESPINS,171)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,171))+1
+10 IF ESPTYPE="C"
SET ^ESP(912.3,ESPIEN,1,ESPINS,172)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,172))+1
Begin DoDot:3
+11 IF ESPCL'="M"
IF ESPCL'="P"
SET ^ESP(912.3,ESPIEN,1,ESPINS,173)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,173))+1
+12 IF ESPCL="M"
SET ^ESP(912.3,ESPIEN,1,ESPINS,174)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,174))+1
+13 IF ESPCL="P"
SET ^ESP(912.3,ESPIEN,1,ESPINS,175)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,175))+1
+14 IF ESPCAT="E"!(ESPCAT="PO")
SET ^ESP(912.3,ESPIEN,1,ESPINS,176)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,176))+1
+15 IF ESPCAT="O"!(ESPCAT="")
SET ^ESP(912.3,ESPIEN,1,ESPINS,177)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,177))+1
+16 IF ESPCAT="P"
SET ^ESP(912.3,ESPIEN,1,ESPINS,178)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,178))+1
+17 IF ESPCAT="V"
SET ^ESP(912.3,ESPIEN,1,ESPINS,179)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,179))+1
End DoDot:3
+18 IF ESPTYPE="V"
SET ^ESP(912.3,ESPIEN,1,ESPINS,180)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,180))+1
Begin DoDot:3
+19 IF ESPCL'="M"
IF ESPCL'="P"
SET ^ESP(912.3,ESPIEN,1,ESPINS,181)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,181))+1
+20 IF ESPCL="M"
SET ^ESP(912.3,ESPIEN,1,ESPINS,182)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,182))+1
+21 IF ESPCL="P"
SET ^ESP(912.3,ESPIEN,1,ESPINS,183)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,183))+1
+22 IF ESPCAT="E"!(ESPCAT="PO")
SET ^ESP(912.3,ESPIEN,1,ESPINS,184)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,184))+1
+23 IF ESPCAT="O"!(ESPCAT="")
SET ^ESP(912.3,ESPIEN,1,ESPINS,185)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,185))+1
+24 IF ESPCAT="P"
SET ^ESP(912.3,ESPIEN,1,ESPINS,186)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,186))+1
+25 IF ESPCAT="V"
SET ^ESP(912.3,ESPIEN,1,ESPINS,187)=$GET(^ESP(912.3,ESPIEN,1,ESPINS,187))+1
End DoDot:3
End DoDot:2
End DoDot:1
+26 KILL STN
+27 LOCK -^ESP(912.3,ESPIEN)
+28 WRITE !!,"Done."
XREF ;
+1 NEW DIK,DIR,X,Y,DA,DIE,DIC
+2 SET DIK="^ESP(912.3,"
SET DA=ESPIEN
+3 DO IX1^DIK
EX if $DATA(DTOUT)
WRITE $CHAR(7)
+1 KILL %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
+2 QUIT
+3 ;
HELP WRITE "??",!?5,"Ending date must not be before beginning date"
GOTO DATE
