ESPORM2 ;DALISC/CKA - OFFENSE REPORT IN MAIL MESSAGE CONT. ;3/93
;;1.0;POLICE & SECURITY;**20**;Mar 31, 1994
EN ;CONTINUED FROM ESPORM1
OFFE ;PRINT OFFENDER(S)
G:'$D(^ESP(912,ESPID,40)) CONT
D HDR:$Y+5>IOSL
F ESPN=0:0 S ESPN=$O(^ESP(912,ESPID,40,ESPN)) Q:ESPN'>0 D
. 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))
. S ESPX=" " D MSG F I=1:1:17 S ESPX=ESPX_"* "
. S ESPX=ESPX_"OFFENDER DATA"
. F I=1:1:16 S ESPX=ESPX_" *"
. D MSG
. S ESPX=" " D MSG S ESPX="OFFENDER NAME: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.02,"E")) D MSG
. 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
. S ESPX="SSN: "_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9) D MSG
. 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
. 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
. 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
. 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
. 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
. S ESPX="STATUS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,.11,"E")) D MSG
. 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
. S ESPX="PERSONAL DESCRIPTION: " D MSG
. S ESPX=$G(^UTILITY("DIQ1",$J,912.05,DA,3.01,"E")) D MSG
. S ESPX="HOME ADDRESS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,1.01,"E")) D MSG
. I $G(^UTILITY("DIQ1",$J,912.05,DA,1.02,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E") D MSG
. I $G(^UTILITY("DIQ1",$J,912.05,DA,1.03,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E")_","
. 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
. S ESPX="HOME PHONE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,1.06,"E")) D MSG
. S ESPX="WORK ADDRESS: "_$G(^UTILITY("DIQ1",$J,912.05,DA,2.01,"E")) D MSG
. I $G(^UTILITY("DIQ1",$J,912.05,DA,2.02,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E") D MSG
. I $G(^UTILITY("DIQ1",$J,912.05,DA,2.03,"E"))]"" S ESPX=$E(SPACES,1,14)_^("E")_","
. 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
. S ESPX="WORK PHONE: "_$G(^UTILITY("DIQ1",$J,912.05,DA,2.06,"E")) D MSG
. F ESPN1=0:0 S ESPN1=$O(^ESP(912,ESPID,40,ESPN,10,ESPN1)) Q:ESPN1'>0 D
.. 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))
.. 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
.. S ESPX="DISPOSITION: "_$G(^UTILITY("DIQ1",$J,912.11,DA,.02,"E"))
.. S ESPX=ESPX_" CHARGING DOCUMENT: "_$G(^UTILITY("DIQ1",$J,912.11,DA,.04,"E")) D MSG
;
CONT G ^ESPORM3
EXIT 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
K ^UTILITY("DIQ1",$J),^TMP($J,"UORM")
QUIT
HDR ;PRINT HEADING
S PAGE=PAGE+1 S ESPX=$E(SPACES,1,25)_"DEPARTMENT OF VETERANS AFFAIRS"_$E(SPACES,1,IOM-10)_"PAGE: "_$J(PAGE,3)
D MSG
S ESPX=$E(SPACES,1,35)_"VA POLICE" D MSG
S ESPX=$E(SPACES,1,28)_"UNIFORM OFFENSE REPORT"
D MSG
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)
D MSG
S ESPX="VA Facility" D MSG
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
S ESPX="Automated VA Form 10-1393" D MSG
F ESPI=1:1:2 S ESPX=" " D MSG
QUIT
MSG S ^TMP($J,"UORM",ESPL)=ESPX,ESPL=ESPL+1
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPORM2 4160 printed Dec 13, 2024@02:30:02 Page 2
ESPORM2 ;DALISC/CKA - OFFENSE REPORT IN MAIL MESSAGE CONT. ;3/93
+1 ;;1.0;POLICE & SECURITY;**20**;Mar 31, 1994
EN ;CONTINUED FROM ESPORM1
OFFE ;PRINT OFFENDER(S)
+1 if '$DATA(^ESP(912,ESPID,40))
GOTO CONT
+2 if $Y+5>IOSL
DO HDR
+3 FOR ESPN=0:0
SET ESPN=$ORDER(^ESP(912,ESPID,40,ESPN))
if ESPN'>0
QUIT
Begin DoDot:1
+4 SET DIC="^ESP(912,"_ESPID_",40,"
SET DA=ESPN
SET DR=".02:.13;1.01:1.06;2.01:2.06;3.01"
SET DIQ(0)="IE"
DO EN^DIQ1
if '$DATA(^UTILITY("DIQ1",$JOB,912.05,DA))
QUIT
+5 SET ESPX=" "
DO MSG
FOR I=1:1:17
SET ESPX=ESPX_"* "
+6 SET ESPX=ESPX_"OFFENDER DATA"
+7 FOR I=1:1:16
SET ESPX=ESPX_" *"
+8 DO MSG
+9 SET ESPX=" "
DO MSG
SET ESPX="OFFENDER NAME: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.02,"E"))
DO MSG
+10 SET ESPFN=$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.02,"I"))
SET SSN=$PIECE($GET(^ESP(910,+ESPFN,0)),U,2)
SET ESPDOB=$PIECE($GET(^ESP(910,+ESPFN,0)),U,3)
SET Y=ESPDOB
XECUTE ^DD("DD")
SET ESPDOBP=Y
+11 SET ESPX="SSN: "_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
DO MSG
+12 SET ESPX="DOB: "_ESPDOBP_" "
DO NOW^%DTC
SET X1=%
SET X2=ESPDOB
SET X=""
if X2]""
SET X=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
SET ESPX=ESPX_"AGE: "_X
DO MSG
+13 SET ESPX="SEX: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.03,"E"))_$EXTRACT(SPACES,1,10)_"RACE: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.04,"E"))
DO MSG
+14 SET ESPX="HEIGHT: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.05,"E"))_$EXTRACT(SPACES,1,10)_"WEIGHT: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.06,"E"))
DO MSG
+15 SET ESPX="HAIR COLOR: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.07,"E"))_$EXTRACT(SPACES,1,20)_"EYE COLOR: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.08,"E"))
DO MSG
+16 SET ESPX="SKIN TONE: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.09,"E"))_$EXTRACT(SPACES,1,40)_"SCARS/MARKS: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.1,"E"))
DO MSG
+17 SET ESPX="STATUS: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.11,"E"))
DO MSG
+18 SET ESPX="DRIVER'S LICENSE & STATE: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.12,"E"))_" "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,.13,"E"))
DO MSG
+19 SET ESPX="PERSONAL DESCRIPTION: "
DO MSG
+20 SET ESPX=$GET(^UTILITY("DIQ1",$JOB,912.05,DA,3.01,"E"))
DO MSG
+21 SET ESPX="HOME ADDRESS: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,1.01,"E"))
DO MSG
+22 IF $GET(^UTILITY("DIQ1",$JOB,912.05,DA,1.02,"E"))]""
SET ESPX=$EXTRACT(SPACES,1,14)_^("E")
DO MSG
+23 IF $GET(^UTILITY("DIQ1",$JOB,912.05,DA,1.03,"E"))]""
SET ESPX=$EXTRACT(SPACES,1,14)_^("E")_","
+24 SET ESPX=ESPX_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,1.04,"E"))_" "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,1.05,"E"))
DO MSG
+25 SET ESPX="HOME PHONE: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,1.06,"E"))
DO MSG
+26 SET ESPX="WORK ADDRESS: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,2.01,"E"))
DO MSG
+27 IF $GET(^UTILITY("DIQ1",$JOB,912.05,DA,2.02,"E"))]""
SET ESPX=$EXTRACT(SPACES,1,14)_^("E")
DO MSG
+28 IF $GET(^UTILITY("DIQ1",$JOB,912.05,DA,2.03,"E"))]""
SET ESPX=$EXTRACT(SPACES,1,14)_^("E")_","
+29 SET ESPX=ESPX_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,2.04,"E"))_" "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,2.05,"E"))
DO MSG
+30 SET ESPX="WORK PHONE: "_$GET(^UTILITY("DIQ1",$JOB,912.05,DA,2.06,"E"))
DO MSG
+31 FOR ESPN1=0:0
SET ESPN1=$ORDER(^ESP(912,ESPID,40,ESPN,10,ESPN1))
if ESPN1'>0
QUIT
Begin DoDot:2
+32 SET DIC="^ESP(912,"_ESPID_",40,"_ESPN_",10,"
SET DA=ESPN1
SET DR=".01;.02;.03;.04"
SET DIQ(0)="IE"
DO EN^DIQ1
if '$DATA(^UTILITY("DIQ1",$JOB,912.11,DA))
QUIT
+33 SET ESPX="OFFENSE COMMITTED: "_$GET(^UTILITY("DIQ1",$JOB,912.11,DA,.01,"E"))_" "_$PIECE($GET(^ESP(915,+$GET(^("I")),0)),U,3)_" "_$PIECE($GET(^(0)),U,5)
DO MSG
+34 SET ESPX="DISPOSITION: "_$GET(^UTILITY("DIQ1",$JOB,912.11,DA,.02,"E"))
+35 SET ESPX=ESPX_" CHARGING DOCUMENT: "_$GET(^UTILITY("DIQ1",$JOB,912.11,DA,.04,"E"))
DO MSG
End DoDot:2
End DoDot:1
+36 ;
CONT GOTO ^ESPORM3
EXIT KILL 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
+1 KILL ^UTILITY("DIQ1",$JOB),^TMP($JOB,"UORM")
+2 QUIT
HDR ;PRINT HEADING
+1 SET PAGE=PAGE+1
SET ESPX=$EXTRACT(SPACES,1,25)_"DEPARTMENT OF VETERANS AFFAIRS"_$EXTRACT(SPACES,1,IOM-10)_"PAGE: "_$JUSTIFY(PAGE,3)
+2 DO MSG
+3 SET ESPX=$EXTRACT(SPACES,1,35)_"VA POLICE"
DO MSG
+4 SET ESPX=$EXTRACT(SPACES,1,28)_"UNIFORM OFFENSE REPORT"
+5 DO MSG
+6 SET ESPX=$EXTRACT(SPACES,1,30)_"UOR# "_$EXTRACT(ESPDTR,2,3)_"-"_$EXTRACT(ESPDTR,4,5)_"-"_$EXTRACT(ESPDTR,6,7)_"-"_$TRANSLATE($EXTRACT($PIECE(ESPDTR,".",2)_"ZZZZ",1,4),"Z",0)
+7 DO MSG
+8 SET ESPX="VA Facility"
DO MSG
+9 IF $DATA(^ESP(912,ESPID,5))
IF $PIECE(^(5),U)'=""
SET ESPX=$SELECT($DATA(^DIC(4,$PIECE(^(5),U),0)):$PIECE(^(0),U),1:"")
DO MSG
+10 SET ESPX="Automated VA Form 10-1393"
DO MSG
+11 FOR ESPI=1:1:2
SET ESPX=" "
DO MSG
+12 QUIT
MSG SET ^TMP($JOB,"UORM",ESPL)=ESPX
SET ESPL=ESPL+1
+1 QUIT
