source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPORP2.m@ 642

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1ESPORP2 ;DALISC/CKA - PRINT OFFENSE REPORT CONT. ;10/92
2 ;;1.0;POLICE & SECURITY;**17,20**;Mar 31, 1994
3EN ;CONTINUED FROM ESPORP1
4OFFE ;PRINT OFFENDER(S)
5 G:'$D(^ESP(912,ESPID,40)) CONT
6 F ESPN=0:0 S ESPN=$O(^ESP(912,ESPID,40,ESPN)) Q:ESPN'>0!(END) D
7 . 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))
8 . D MIN^ESPORP(10) Q:END
9 . D LINES^ESPORP(2) Q:END F I=1:1:17 W "* "
10 . W "OFFENDER DATA"
11 . F I=1:1:16 W " *"
12 . D LINES^ESPORP(2) Q:END W "OFFENDER NAME: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.02,"E"))
13 . 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
14 . D LINES^ESPORP() Q:END W "SSN: ",$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,9)
15 . W ?24,"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)) W ?62,"AGE: ",X
16 . D LINES^ESPORP() Q:END W "SEX: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.03,"E"))
17 . W ?24,"RACE: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.04,"E"))
18 . W ?62,"HEIGHT: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.05,"E"))
19 . D LINES^ESPORP() Q:END W "WEIGHT: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.06,"E"))
20 . W ?24,"HAIR COLOR: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.07,"E"))
21 . W ?62,"EYE COLOR: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.08,"E"))
22 . D LINES^ESPORP() Q:END W "SKIN TONE: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.09,"E")),?24,"SCARS/MARKS: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.1,"E"))
23 . D LINES^ESPORP() Q:END W "STATUS: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.11,"E"))
24 . D LINES^ESPORP() Q:END W "DRIVER'S LICENSE & STATE: ",$G(^UTILITY("DIQ1",$J,912.05,DA,.12,"E"))," ",$G(^UTILITY("DIQ1",$J,912.05,DA,.13,"E"))
25 . D LINES^ESPORP() Q:END W "PERSONAL DESCRIPTION: "
26 . D LINES^ESPORP() Q:END W $G(^UTILITY("DIQ1",$J,912.05,DA,3.01,"E"))
27 . D LINES^ESPORP() Q:END W "HOME ADDRESS: ",$G(^UTILITY("DIQ1",$J,912.05,DA,1.01,"E"))
28 . I $G(^UTILITY("DIQ1",$J,912.05,DA,1.02,"E"))]"" D LINES^ESPORP() Q:END W ?14,$G(^UTILITY("DIQ1",$J,912.05,DA,1.02,"E"))
29 . I $G(^UTILITY("DIQ1",$J,912.05,DA,1.03,"E"))]"" D LINES^ESPORP() Q:END W ?14,$G(^UTILITY("DIQ1",$J,912.05,DA,1.03,"E")),","
30 . W $G(^UTILITY("DIQ1",$J,912.05,DA,1.04,"E"))," ",$G(^UTILITY("DIQ1",$J,912.05,DA,1.05,"E"))
31 . D LINES^ESPORP() Q:END W "HOME PHONE: ",$G(^UTILITY("DIQ1",$J,912.05,DA,1.06,"E"))
32 . D LINES^ESPORP() Q:END W "WORK ADDRESS: ",$G(^UTILITY("DIQ1",$J,912.05,DA,2.01,"E"))
33 . I $G(^UTILITY("DIQ1",$J,912.05,DA,2.02,"E"))]"" D LINES^ESPORP() Q:END W ?14,$G(^UTILITY("DIQ1",$J,912.05,DA,2.02,"E"))
34 . I $G(^UTILITY("DIQ1",$J,912.05,DA,2.03,"E"))]"" D LINES^ESPORP() Q:END W ?14,$G(^UTILITY("DIQ1",$J,912.05,DA,2.03,"E")),","
35 . W $G(^UTILITY("DIQ1",$J,912.05,DA,2.04,"E"))," ",$G(^UTILITY("DIQ1",$J,912.05,DA,2.05,"E"))
36 . D LINES^ESPORP() Q:END W "WORK PHONE: ",$G(^UTILITY("DIQ1",$J,912.05,DA,2.06,"E"))
37 . F ESPN1=0:0 S ESPN1=$O(^ESP(912,ESPID,40,ESPN,10,ESPN1)) Q:ESPN1'>0 D
38 .. 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))
39 .. D MIN^ESPORP(5) Q:END
40 .. D LINES^ESPORP() Q:END W "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)
41 .. D LINES^ESPORP() Q:END W "DISPOSITION: " W:$G(^UTILITY("DIQ1",$J,912.11,DA,.02,"E"))'=0 ^("E")
42 .. W " CHARGING DOCUMENT: ",$G(^UTILITY("DIQ1",$J,912.11,DA,.04,"E"))
43 ;
44CONT G:END EXIT G ^ESPORP3
45EXIT K CL,DA,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,ESPDOB,ESPDOBP,DR,DTOUT,DUOUT,END,ESPDTR,ESPID,ESPFN,ESPN,ESPN1,IEN,PAGE,SSN,X,Y
46 K ^UTILITY("DIQ1",$J)
47 QUIT
Note: See TracBrowser for help on using the repository browser.