Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ESPUCM

ESPUCM.m

Go to the documentation of this file.
ESPUCM ;DALISC/CKA -UNIFORM CRIME REPORT IN MAIL MESSAGE- 4/93
 ;;1.0;POLICE & SECURITY;**13**;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.4,",DIC(0)="AEMQ",DIC("A")="  Beginning DATE of Report to Print : " D ^DIC
 I Y<0 G EX
 S ESPIEN=+Y
NDB ; ask about transmission to national database
 N ESPFLG
 D VADB
START ; BEGINS THE PRINT OF THIS CRIME REPORT
MM S ESPL=0,PAGE=0,SPACES="                                                   ",IOM=79,IOSL=64
 W !,"Mail message is now being created."
 K ^UTILITY("DIQ1",$J),^TMP($J,"UCM") D HDR
 S DIC="^ESP(912.4,",DA=ESPIEN,DR=".01;.02",DIQ(0)="E" D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J,912.4,DA)) W !,"RECORD DOESN'T EXIST!" G EX
BDT S ESPX=$E(SPACES,1,45)_"BEGINNING DATE: "_$G(^UTILITY("DIQ1",$J,912.4,DA,.01,"E")) D MSG
EDT S ESPX=$E(SPACES,1,45)_"ENDING DATE: "_$G(^UTILITY("DIQ1",$J,912.4,DA,.02,"E")) D MSG
 F ESPN=0:0 S ESPN=$O(^ESP(912.4,ESPIEN,1,ESPN)) Q:ESPN'>0  D PRT^ESPUCM1
EX K BEGDATE,DA,DIC,DIQ,DR,ESPIEN,ESPL,ESPN,ESPX,PAGE,SPACES,TOT,Y,^UTILITY("DIQ1",$J),^TMP($J,"UCM")
 QUIT
HDR ;PRINT HEADING
 S PAGE=PAGE+1 S ESPX=$E(SPACES,1,25)_"DEPARTMENT OF VETERANS AFFAIRS"_$E(SPACES,1,(IOM-65))_"PAGE:  "_$J(PAGE,3) D MSG
 S ESPX=$E(SPACES,1,35)_"VA POLICE" D MSG S ESPX=$E(SPACES,1,33)_"UNIFORM CRIME REPORT" D MSG
 S ESPX=" " D MSG S ESPX="VA Facility "_$P(^ESP(912.4,ESPIEN,1,1,0),U) D MSG
 QUIT
MSG S ^TMP($J,"UCM",ESPL)=ESPX,ESPL=ESPL+1
 QUIT
VADB ; transmit to national database
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 W !
 S DIR("A")="Do you want to transmit this report to the National Database (XXX@Q-VAP.DOMAIN.EXT)",DIR("B")="NO",DIR(0)="Y"
 D ^DIR
 S ESPFLG=Y
 W !
 QUIT