ESPUCFP ;DALISC/CKA -PRINT UNIFORM CRIME REPORT BY FACILITY- 3/99
;;1.0;POLICE & SECURITY;**27,35**;Mar 31, 1994
EN ;
I '$D(DUZ(2)) W !,"Site # is not defined!" G EX
DATE ;ASK BEGINNING DATE
D DT^DICRW K BEGDATE
ASK ;ASK FOR CRIME DATA DATE TO PRINT
S DIC="^ESP(912.3,",DIC(0)="AEMQ",DIC("A")=" Beginning DATE of Report to Print : " D ^DIC
I Y<0 G EX
S ESPIEN=+Y
DIV ;GET THE DIVISION
D DIVISION^VAUTOMA
I VAUTD=1 K ^ESP(912.3,ESPIEN,1,9999) S ^ESP(912.3,ESPIEN,1,"B",9999,9999)="",^ESP(912.3,ESPIEN,1,9999,0)=9999 D
. F ESPN=0:0 S ESPN=$O(^ESP(912.3,ESPIEN,1,ESPN)) Q:+ESPN=0!(ESPN=9999) D
.. F CTR=0:0 S CTR=$O(^ESP(912.3,ESPIEN,1,ESPN,CTR)) Q:CTR="" D
... S CAMT=$G(^ESP(912.3,ESPIEN,1,ESPN,CTR))
... S ^ESP(912.3,ESPIEN,1,9999,CTR)=$G(^ESP(912.3,ESPIEN,1,9999,CTR))+CAMT
K:VAUTD=1 CAMT,CTR
PRT ;PRINT REPORT
Q S %ZIS="Q" D ^%ZIS G:POP EX I '$D(IO("Q")) U IO D START G EX
S ZTRTN="START^ESPUCFP",ZTDESC="UNIFORM CRIME REPORT"
S ZTSAVE("ESP*")="",ZTSAVE("VAUTD*")=""
D ^%ZTLOAD,HOME^%ZIS G EX
START ; BEGINS THE PRINT OF THIS CRIME REPORT
S HOF=0,TFAC=0
K ^UTILITY("DIQ1",$J) S (END,PAGE)=0
S DIC="^ESP(912.3,",DA=ESPIEN,DR=".01;.02",DIQ(0)="E" D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J,912.3,DA)) W !,"RECORD DOESN'T EXIST!" G EX
F ESPN=0:0 S ESPN=$O(^ESP(912.3,ESPIEN,1,ESPN)) Q:ESPN=""!(END)!(+ESPN=0) D
.I +$G(VAUTD)'=1,'$D(VAUTD(+$P(^ESP(912.3,ESPIEN,1,ESPN,0),U))) Q
.I TFAC=1,ESPN=9999 Q
.S TFAC=TFAC+1
.D HDR Q:END
.D PRT^ESPUCFP1
W !!,"Done."
QUIT
EX D ^%ZISC
K %ZIS,BEGDATE,DA,DIC,DIQ,DR,END,ESPIEN,ESPN,HOF,PAGE,TFAC,TOT,X,Y,^UTILITY("DIQ1",$J)
QUIT
HDR ;PRINT HEADING
I $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
S PAGE=PAGE+1 W:HOF=1 @IOF W !?25,"DEPARTMENT OF VETERANS AFFAIRS",?70,"PAGE ",$J(PAGE,3)
W !?35,"VA POLICE",!?33,"UNIFORM CRIME REPORT"
S:ESPN=9999 ESPFACI="*** ALL DIVISIONS ***"
S:ESPN'=9999 ESPFACI=$P(^ESP(912.3,ESPIEN,1,ESPN,0),U),ESPFACI=$P($G(^DG(40.8,ESPFACI,0)),U)_" ("_$P($G(^ESP(912.3,ESPIEN,1,ESPN,0)),U,2)_")"
W !!,"VA Facility: ",ESPFACI
W ?52,"BEGINNING DATE: ",$G(^UTILITY("DIQ1",$J,912.3,ESPIEN,.01,"E"))
W !,"Date/Time Printed",?52,"ENDING DATE: ",$G(^UTILITY("DIQ1",$J,912.3,ESPIEN,.02,"E"))
D NOW^%DTC S Y=% X ^DD("DD") W !,$P(Y,":",1,2)
S HOF=1
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPUCFP 2351 printed Nov 22, 2024@17:40:31 Page 2
ESPUCFP ;DALISC/CKA -PRINT UNIFORM CRIME REPORT BY FACILITY- 3/99
+1 ;;1.0;POLICE & SECURITY;**27,35**;Mar 31, 1994
EN ;
+1 IF '$DATA(DUZ(2))
WRITE !,"Site # is not defined!"
GOTO EX
DATE ;ASK BEGINNING DATE
+1 DO DT^DICRW
KILL BEGDATE
ASK ;ASK FOR CRIME DATA DATE TO PRINT
+1 SET DIC="^ESP(912.3,"
SET DIC(0)="AEMQ"
SET DIC("A")=" Beginning DATE of Report to Print : "
DO ^DIC
+2 IF Y<0
GOTO EX
+3 SET ESPIEN=+Y
DIV ;GET THE DIVISION
+1 DO DIVISION^VAUTOMA
+2 IF VAUTD=1
KILL ^ESP(912.3,ESPIEN,1,9999)
SET ^ESP(912.3,ESPIEN,1,"B",9999,9999)=""
SET ^ESP(912.3,ESPIEN,1,9999,0)=9999
Begin DoDot:1
+3 FOR ESPN=0:0
SET ESPN=$ORDER(^ESP(912.3,ESPIEN,1,ESPN))
if +ESPN=0!(ESPN=9999)
QUIT
Begin DoDot:2
+4 FOR CTR=0:0
SET CTR=$ORDER(^ESP(912.3,ESPIEN,1,ESPN,CTR))
if CTR=""
QUIT
Begin DoDot:3
+5 SET CAMT=$GET(^ESP(912.3,ESPIEN,1,ESPN,CTR))
+6 SET ^ESP(912.3,ESPIEN,1,9999,CTR)=$GET(^ESP(912.3,ESPIEN,1,9999,CTR))+CAMT
End DoDot:3
End DoDot:2
End DoDot:1
+7 if VAUTD=1
KILL CAMT,CTR
PRT ;PRINT REPORT
Q SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EX
IF '$DATA(IO("Q"))
USE IO
DO START
GOTO EX
+1 SET ZTRTN="START^ESPUCFP"
SET ZTDESC="UNIFORM CRIME REPORT"
+2 SET ZTSAVE("ESP*")=""
SET ZTSAVE("VAUTD*")=""
+3 DO ^%ZTLOAD
DO HOME^%ZIS
GOTO EX
START ; BEGINS THE PRINT OF THIS CRIME REPORT
+1 SET HOF=0
SET TFAC=0
+2 KILL ^UTILITY("DIQ1",$JOB)
SET (END,PAGE)=0
+3 SET DIC="^ESP(912.3,"
SET DA=ESPIEN
SET DR=".01;.02"
SET DIQ(0)="E"
DO EN^DIQ1
IF '$DATA(^UTILITY("DIQ1",$JOB,912.3,DA))
WRITE !,"RECORD DOESN'T EXIST!"
GOTO EX
+4 FOR ESPN=0:0
SET ESPN=$ORDER(^ESP(912.3,ESPIEN,1,ESPN))
if ESPN=""!(END)!(+ESPN=0)
QUIT
Begin DoDot:1
+5 IF +$GET(VAUTD)'=1
IF '$DATA(VAUTD(+$PIECE(^ESP(912.3,ESPIEN,1,ESPN,0),U)))
QUIT
+6 IF TFAC=1
IF ESPN=9999
QUIT
+7 SET TFAC=TFAC+1
+8 DO HDR
if END
QUIT
+9 DO PRT^ESPUCFP1
End DoDot:1
+10 WRITE !!,"Done."
+11 QUIT
EX DO ^%ZISC
+1 KILL %ZIS,BEGDATE,DA,DIC,DIQ,DR,END,ESPIEN,ESPN,HOF,PAGE,TFAC,TOT,X,Y,^UTILITY("DIQ1",$JOB)
+2 QUIT
HDR ;PRINT HEADING
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to continue or '^' to exit: "
READ X:DTIME
SET END='$TEST!(X="^")
if END
QUIT
+2 SET PAGE=PAGE+1
if HOF=1
WRITE @IOF
WRITE !?25,"DEPARTMENT OF VETERANS AFFAIRS",?70,"PAGE ",$JUSTIFY(PAGE,3)
+3 WRITE !?35,"VA POLICE",!?33,"UNIFORM CRIME REPORT"
+4 if ESPN=9999
SET ESPFACI="*** ALL DIVISIONS ***"
+5 if ESPN'=9999
SET ESPFACI=$PIECE(^ESP(912.3,ESPIEN,1,ESPN,0),U)
SET ESPFACI=$PIECE($GET(^DG(40.8,ESPFACI,0)),U)_" ("_$PIECE($GET(^ESP(912.3,ESPIEN,1,ESPN,0)),U,2)_")"
+6 WRITE !!,"VA Facility: ",ESPFACI
+7 WRITE ?52,"BEGINNING DATE: ",$GET(^UTILITY("DIQ1",$JOB,912.3,ESPIEN,.01,"E"))
+8 WRITE !,"Date/Time Printed",?52,"ENDING DATE: ",$GET(^UTILITY("DIQ1",$JOB,912.3,ESPIEN,.02,"E"))
+9 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE !,$PIECE(Y,":",1,2)
+10 SET HOF=1
+11 QUIT
