source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPUCFP.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1ESPUCFP ;DALISC/CKA -PRINT UNIFORM CRIME REPORT BY FACILITY- 3/99
2 ;;1.0;POLICE & SECURITY;**27,35**;Mar 31, 1994
3EN ;
4 I '$D(DUZ(2)) W !,"Site # is not defined!" G EX
5DATE ;ASK BEGINNING DATE
6 D DT^DICRW K BEGDATE
7ASK ;ASK FOR CRIME DATA DATE TO PRINT
8 S DIC="^ESP(912.3,",DIC(0)="AEMQ",DIC("A")=" Beginning DATE of Report to Print : " D ^DIC
9 I Y<0 G EX
10 S ESPIEN=+Y
11DIV ;GET THE DIVISION
12 D DIVISION^VAUTOMA
13 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
14 . F ESPN=0:0 S ESPN=$O(^ESP(912.3,ESPIEN,1,ESPN)) Q:+ESPN=0!(ESPN=9999) D
15 .. F CTR=0:0 S CTR=$O(^ESP(912.3,ESPIEN,1,ESPN,CTR)) Q:CTR="" D
16 ... S CAMT=$G(^ESP(912.3,ESPIEN,1,ESPN,CTR))
17 ... S ^ESP(912.3,ESPIEN,1,9999,CTR)=$G(^ESP(912.3,ESPIEN,1,9999,CTR))+CAMT
18 K:VAUTD=1 CAMT,CTR
19PRT ;PRINT REPORT
20Q S %ZIS="Q" D ^%ZIS G:POP EX I '$D(IO("Q")) U IO D START G EX
21 S ZTRTN="START^ESPUCFP",ZTDESC="UNIFORM CRIME REPORT"
22 S ZTSAVE("ESP*")="",ZTSAVE("VAUTD*")=""
23 D ^%ZTLOAD,HOME^%ZIS G EX
24START ; BEGINS THE PRINT OF THIS CRIME REPORT
25 S HOF=0,TFAC=0
26 K ^UTILITY("DIQ1",$J) S (END,PAGE)=0
27 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
28 F ESPN=0:0 S ESPN=$O(^ESP(912.3,ESPIEN,1,ESPN)) Q:ESPN=""!(END)!(+ESPN=0) D
29 .I +$G(VAUTD)'=1,'$D(VAUTD(+$P(^ESP(912.3,ESPIEN,1,ESPN,0),U))) Q
30 .I TFAC=1,ESPN=9999 Q
31 .S TFAC=TFAC+1
32 .D HDR Q:END
33 .D PRT^ESPUCFP1
34 W !!,"Done."
35 QUIT
36EX D ^%ZISC
37 K %ZIS,BEGDATE,DA,DIC,DIQ,DR,END,ESPIEN,ESPN,HOF,PAGE,TFAC,TOT,X,Y,^UTILITY("DIQ1",$J)
38 QUIT
39HDR ;PRINT HEADING
40 I $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
41 S PAGE=PAGE+1 W:HOF=1 @IOF W !?25,"DEPARTMENT OF VETERANS AFFAIRS",?70,"PAGE ",$J(PAGE,3)
42 W !?35,"VA POLICE",!?33,"UNIFORM CRIME REPORT"
43 S:ESPN=9999 ESPFACI="*** ALL DIVISIONS ***"
44 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)_")"
45 W !!,"VA Facility: ",ESPFACI
46 W ?52,"BEGINNING DATE: ",$G(^UTILITY("DIQ1",$J,912.3,ESPIEN,.01,"E"))
47 W !,"Date/Time Printed",?52,"ENDING DATE: ",$G(^UTILITY("DIQ1",$J,912.3,ESPIEN,.02,"E"))
48 D NOW^%DTC S Y=% X ^DD("DD") W !,$P(Y,":",1,2)
49 S HOF=1
50 QUIT
Note: See TracBrowser for help on using the repository browser.