source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPORM2.m@ 701

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1ESPORM2 ;DALISC/CKA - OFFENSE REPORT IN MAIL MESSAGE CONT. ;3/93
2 ;;1.0;POLICE & SECURITY;**20**;Mar 31, 1994
3EN ;CONTINUED FROM ESPORM1
4OFFE ;PRINT OFFENDER(S)
5 G:'$D(^ESP(912,ESPID,40)) CONT
6 D HDR:$Y+5>IOSL
7 F ESPN=0:0 S ESPN=$O(^ESP(912,ESPID,40,ESPN)) Q:ESPN'>0 D
8 . S DIC="^ESP(912,"_ESPID_",40,",DA=ESPN,DR=".02:.13;1.01:1.06;2.01:2.06;3.01",DIQ(0)="IE" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.05,DA))
9 . S ESPX=" " D MSG F I=1:1:17 S ESPX=ESPX_"* "
10 . S ESPX=ESPX_"OFFENDER DATA"
11 . F I=1:1:16 S ESPX=ESPX_" *"
12 . D MSG
13 . S ESPX=" " D MSG S ESPX="OFFENDER NAME: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.02,"E")) D MSG
14 . S ESPFN=$G(^UTILITY("DIQ1",$J,912.05,DA,.02,"I")),SSN=$P($G(^ESP(910,+ESPFN,0)),U,2),ESPDOB=$P($G(^ESP(910,+ESPFN,0)),U,3),Y=ESPDOB X ^DD("DD") S ESPDOBP=Y
15 . S ESPX="SSN: "_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9) D MSG
16 . S ESPX="DOB: "_ESPDOBP_" " D NOW^%DTC S X1=%,X2=ESPDOB,X="" S:X2]"" X=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7)) S ESPX=ESPX_"AGE: "_X D MSG
17 . S ESPX="SEX: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.03,"E"))_$E(SPACES,1,10)_"RACE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.04,"E")) D MSG
18 . S ESPX="HEIGHT: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.05,"E"))_$E(SPACES,1,10)_"WEIGHT: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.06,"E")) D MSG
19 . S ESPX="HAIR COLOR: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.07,"E"))_$E(SPACES,1,20)_"EYE COLOR: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.08,"E")) D MSG
20 . S ESPX="SKIN TONE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.09,"E"))_$E(SPACES,1,40)_"SCARS/MARKS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.1,"E")) D MSG
21 . S ESPX="STATUS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.11,"E")) D MSG
22 . S ESPX="DRIVER'S LICENSE & STATE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.12,"E"))_" "_$G(^UTILITY("DIQ1",$J,912.05,DA,.13,"E")) D MSG
23 . S ESPX="PERSONAL DESCRIPTION: " D MSG
24 . S ESPX=$G(^UTILITY("DIQ1",$J,912.05,DA,3.01,"E")) D MSG
25 . S ESPX="HOME ADDRESS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,1.01,"E")) D MSG
26 . I $G(^UTILITY("DIQ1",$J,912.05,DA,1.02,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E") D MSG
27 . I $G(^UTILITY("DIQ1",$J,912.05,DA,1.03,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E")_","
28 . S ESPX=ESPX_$G(^UTILITY("DIQ1",$J,912.05,DA,1.04,"E"))_" "_$G(^UTILITY("DIQ1",$J,912.05,DA,1.05,"E")) D MSG
29 . S ESPX="HOME PHONE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,1.06,"E")) D MSG
30 . S ESPX="WORK ADDRESS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,2.01,"E")) D MSG
31 . I $G(^UTILITY("DIQ1",$J,912.05,DA,2.02,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E") D MSG
32 . I $G(^UTILITY("DIQ1",$J,912.05,DA,2.03,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E")_","
33 . S ESPX=ESPX_$G(^UTILITY("DIQ1",$J,912.05,DA,2.04,"E"))_" "_$G(^UTILITY("DIQ1",$J,912.05,DA,2.05,"E")) D MSG
34 . S ESPX="WORK PHONE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,2.06,"E")) D MSG
35 . F ESPN1=0:0 S ESPN1=$O(^ESP(912,ESPID,40,ESPN,10,ESPN1)) Q:ESPN1'>0 D
36 .. S DIC="^ESP(912,"_ESPID_",40,"_ESPN_",10,",DA=ESPN1,DR=".01;.02;.03;.04",DIQ(0)="IE" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.11,DA))
37 .. S ESPX="OFFENSE COMMITTED: "_$G(^UTILITY("DIQ1",$J,912.11,DA,.01,"E"))_" "_$P($G(^ESP(915,+$G(^("I")),0)),U,3)_" "_$P($G(^(0)),U,5) D MSG
38 .. S ESPX="DISPOSITION: "_$G(^UTILITY("DIQ1",$J,912.11,DA,.02,"E"))
39 .. S ESPX=ESPX_" CHARGING DOCUMENT: "_$G(^UTILITY("DIQ1",$J,912.11,DA,.04,"E")) D MSG
40 ;
41CONT G ^ESPORM3
42EXIT K DA,DIC,DIQ,DIRUT,ESPDOB,ESPDOBP,DR,DTOUT,DUOUT,ESPDTR,ESPFN,ESPI,ESPID,ESPL,ESPN,ESPN1,ESPX,I,IEN,PAGE,SPACES,SSN,X,X1,X2,Y
43 K ^UTILITY("DIQ1",$J),^TMP($J,"UORM")
44 QUIT
45HDR ;PRINT HEADING
46 S PAGE=PAGE+1 S ESPX=$E(SPACES,1,25)_"DEPARTMENT OF VETERANS AFFAIRS"_$E(SPACES,1,IOM-10)_"PAGE: "_$J(PAGE,3)
47 D MSG
48 S ESPX=$E(SPACES,1,35)_"VA POLICE" D MSG
49 S ESPX=$E(SPACES,1,28)_"UNIFORM OFFENSE REPORT"
50 D MSG
51 S ESPX=$E(SPACES,1,30)_"UOR# "_$E(ESPDTR,2,3)_"-"_$E(ESPDTR,4,5)_"-"_$E(ESPDTR,6,7)_"-"_$TR($E($P(ESPDTR,".",2)_"ZZZZ",1,4),"Z",0)
52 D MSG
53 S ESPX="VA Facility" D MSG
54 I $D(^ESP(912,ESPID,5)),$P(^(5),U)'="" S ESPX=$S($D(^DIC(4,$P(^(5),U),0)):$P(^(0),U),1:"") D MSG
55 S ESPX="Automated VA Form 10-1393" D MSG
56 F ESPI=1:1:2 S ESPX=" " D MSG
57 QUIT
58MSG S ^TMP($J,"UORM",ESPL)=ESPX,ESPL=ESPL+1
59 QUIT
Note: See TracBrowser for help on using the repository browser.