ESPOFF ;DALISC/CKA - OFFENSE REPORT INPUT;3/99
;;1.0;POLICE & SECURITY;**9,12,27,39**;Mar 31, 1994
EN ;
D DT^DICRW S ESPVAR=3
I '$D(DUZ(2)) W !!,"SITE # IS NOT DEFINED." G EXIT
DTR S NOUPD=0 W !! S DIR(0)="DO^::ETXR",DIR("A")="DATE/TIME RECEIVED",DIR("?")="^W !!,?10,""Enter the date and time the complaint is received. You must enter a time."" S %DT=""ETXR"" D HELP^%DTC"
D ^DIR K DIR G:$D(DIRUT) EXIT S ESPDTR=Y
LKUP S DIC="^ESP(912,",DIC(0)="XMZ" D ^DIC K DIC S ESPY=+Y
I Y>0 D MSG G NOUPD
FAC S ESPX=".07" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(.07)=+Y
S ESPN=1
CL S DIR(0)="912.01,.01",DIR("A")="CLASSIFICATION CODE" D ^DIR K DIR G:$D(DUOUT)!($D(DTOUT)) NOUPD G:$D(DIRUT) DTO
S (ESPCL(ESPN),ESPS)=+Y S:'+Y ESPCL(ESPN)=""
I '$O(^ESP(912.8,"AC",ESPS,0)) G SCL
TYPE S DIR(0)="912.01,.02",DIR("A")="TYPE" D ^DIR K DIR G:$D(DUOUT)!($D(DTOUT)) NOUPD
S $P(ESPCL(ESPN),U,2)=+Y,ESPS=+Y_"^"_ESPS S:'+Y $P(ESPCL(ESPN),U,2)=""
I '$O(^ESP(912.9,"AC",+Y,0)) G SCL
SUB S DIR(0)="912.01,.03",DIR("A")="SUBTYPE" D ^DIR K DIR G:$D(DUOUT)!($D(DTOUT)) NOUPD
S $P(ESPCL(ESPN),U,3)=+Y S:'+Y $P(ESPCL(ESPN),U,3)=""
SCL S ^TMP($J,"UOR","CL",ESPN,0)=ESPCL(ESPN)
ASK S DIR(0)="Y",DIR("A")="Do you want to enter another classification code",DIR("B")="NO" D ^DIR K DIR
G:$D(DTOUT) NOUPD
I Y'=1&(Y'=0) W !!,$C(7),?5,"You must enter Yes or No." G ASK
I Y S ESPN=ESPN+1 G CL
DTO S ESPX=".03" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(.03)=Y
I ESPD(.03)>ESPDTR W !!,$C(7),"Date/time of Offense must be before Date/time Received!",! G DTO
EDTO S ESPX=".09" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(.09)=Y
I ESPD(.09)'="",ESPD(.03)>ESPD(.09) W !!,$C(7),"Ending Date/time of Offense must be after Date/time of Offense!",! G EDTO
LOC S ESPX=".04" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(.04)=Y
WEAP S ESPX=".05" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(.05)=Y
MO W !,"METHOD OF OPERATION: " S DWLW=80,DWPK=1,DIC="^TMP($J,""MO"",",DIWESUB="METHOD OF OPERATION" D EN^DIWE
G:$D(DTOUT) NOUPD
POL N TYPE S ESPX=".06" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S:'+Y ESPD(.06)="" I +Y S ESPD(.06)=+Y D SET(+Y,0)
CIP S ESPX="1.01" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(1.01)=Y
BAT S ESPX="1.02" D RD G:$D(DUOUT)!($D(DTOUT)) NOUPD S ESPD(1.02)=Y
S ^TMP($J,"UOR",0)="^"_ESPDTR_"^"_ESPD(.03)_"^"_ESPD(.04)_"^"_ESPD(.05)_"^"_ESPD(.06)_"^"_ESPD(.07)_"^O^"_ESPD(.09)_"^^"_ESPD(.11)_"^"_ESPD(.12)
S ^TMP($J,"UOR",1)=ESPD(1.01)_"^"_ESPD(1.02)_"^"
G 1^ESPOFF0
EXIT W:$D(DTOUT) $C(7)
K DA,DIC,DIR,DIRUT,DUOUT,ESPCL,ESPD,ESPDTR,ESPFN,ESPN,ESPNOT,ESPS,ESPTEST,ESPVAR,ESPX,ESPY,I,NOUPD,X,Y,^TMP($J)
QUIT
RD S DIR(0)="912,"_ESPX D ^DIR I $S(($L(X)>1&($E(X)=U)):1,($L(X)>1&(X[U)):1,1:0) D NO K X,Y G RD
K DIR Q
NO W $C(7),!!?5,"NO '^'S ALLOWED!",!! Q
;
NOUPD W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPCL,ESPD,ESPDTR,ESPX,ESPY,^TMP($J) G:$D(DTOUT) EXIT G DTR
MSG W !,$C(7),"FOUND" W ?10,"There is already a report for this date/time.",!?10,"Same date/time received NOT allowed.",!?10,"To edit the existing report,",!?10,"you must go to the Edit an Offense Report option."
W !?10,"To complete this report, go to Resume an Offense Report Entry."
Q
SET(NEWKEY,TYPE) ;PULL BADGE/RANK FOR INVESTIGATOR
S:TYPE>0 HDA=DA
S DIC="^VA(200,",DA=NEWKEY,DR="910.1;910.2",DIQ(0)="E",DIQ="POLINF" D EN^DIQ1
S:TYPE>0 SX=$S(TYPE=1:POLINF(200,DA,910.1,"E"),TYPE=2:POLINF(200,DA,910.2,"E"),1:""),DI=.06
S:TYPE=0 ESPD(.11)=POLINF(200,DA,910.1,"E"),ESPD(.12)=POLINF(200,DA,910.2,"E")
K DIC,DIQ,POLINF
Q:TYPE=0
S DA=HDA K HDA
Q SX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPOFF 3562 printed Dec 13, 2024@02:29:49 Page 2
ESPOFF ;DALISC/CKA - OFFENSE REPORT INPUT;3/99
+1 ;;1.0;POLICE & SECURITY;**9,12,27,39**;Mar 31, 1994
EN ;
+1 DO DT^DICRW
SET ESPVAR=3
+2 IF '$DATA(DUZ(2))
WRITE !!,"SITE # IS NOT DEFINED."
GOTO EXIT
DTR SET NOUPD=0
WRITE !!
SET DIR(0)="DO^::ETXR"
SET DIR("A")="DATE/TIME RECEIVED"
SET DIR("?")="^W !!,?10,""Enter the date and time the complaint is received. You must enter a time."" S %DT=""ETXR"" D HELP^%DTC"
+1 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
SET ESPDTR=Y
LKUP SET DIC="^ESP(912,"
SET DIC(0)="XMZ"
DO ^DIC
KILL DIC
SET ESPY=+Y
+1 IF Y>0
DO MSG
GOTO NOUPD
FAC SET ESPX=".07"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(.07)=+Y
+1 SET ESPN=1
CL SET DIR(0)="912.01,.01"
SET DIR("A")="CLASSIFICATION CODE"
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
if $DATA(DIRUT)
GOTO DTO
+1 SET (ESPCL(ESPN),ESPS)=+Y
if '+Y
SET ESPCL(ESPN)=""
+2 IF '$ORDER(^ESP(912.8,"AC",ESPS,0))
GOTO SCL
TYPE SET DIR(0)="912.01,.02"
SET DIR("A")="TYPE"
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
+1 SET $PIECE(ESPCL(ESPN),U,2)=+Y
SET ESPS=+Y_"^"_ESPS
if '+Y
SET $PIECE(ESPCL(ESPN),U,2)=""
+2 IF '$ORDER(^ESP(912.9,"AC",+Y,0))
GOTO SCL
SUB SET DIR(0)="912.01,.03"
SET DIR("A")="SUBTYPE"
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
+1 SET $PIECE(ESPCL(ESPN),U,3)=+Y
if '+Y
SET $PIECE(ESPCL(ESPN),U,3)=""
SCL SET ^TMP($JOB,"UOR","CL",ESPN,0)=ESPCL(ESPN)
ASK SET DIR(0)="Y"
SET DIR("A")="Do you want to enter another classification code"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+1 if $DATA(DTOUT)
GOTO NOUPD
+2 IF Y'=1&(Y'=0)
WRITE !!,$CHAR(7),?5,"You must enter Yes or No."
GOTO ASK
+3 IF Y
SET ESPN=ESPN+1
GOTO CL
DTO SET ESPX=".03"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(.03)=Y
+1 IF ESPD(.03)>ESPDTR
WRITE !!,$CHAR(7),"Date/time of Offense must be before Date/time Received!",!
GOTO DTO
EDTO SET ESPX=".09"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(.09)=Y
+1 IF ESPD(.09)'=""
IF ESPD(.03)>ESPD(.09)
WRITE !!,$CHAR(7),"Ending Date/time of Offense must be after Date/time of Offense!",!
GOTO EDTO
LOC SET ESPX=".04"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(.04)=Y
WEAP SET ESPX=".05"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(.05)=Y
MO WRITE !,"METHOD OF OPERATION: "
SET DWLW=80
SET DWPK=1
SET DIC="^TMP($J,""MO"","
SET DIWESUB="METHOD OF OPERATION"
DO EN^DIWE
+1 if $DATA(DTOUT)
GOTO NOUPD
POL NEW TYPE
SET ESPX=".06"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
if '+Y
SET ESPD(.06)=""
IF +Y
SET ESPD(.06)=+Y
DO SET(+Y,0)
CIP SET ESPX="1.01"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(1.01)=Y
BAT SET ESPX="1.02"
DO RD
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO NOUPD
SET ESPD(1.02)=Y
+1 SET ^TMP($JOB,"UOR",0)="^"_ESPDTR_"^"_ESPD(.03)_"^"_ESPD(.04)_"^"_ESPD(.05)_"^"_ESPD(.06)_"^"_ESPD(.07)_"^O^"_ESPD(.09)_"^^"_ESPD(.11)_"^"_ESPD(.12)
+2 SET ^TMP($JOB,"UOR",1)=ESPD(1.01)_"^"_ESPD(1.02)_"^"
+3 GOTO 1^ESPOFF0
EXIT if $DATA(DTOUT)
WRITE $CHAR(7)
+1 KILL DA,DIC,DIR,DIRUT,DUOUT,ESPCL,ESPD,ESPDTR,ESPFN,ESPN,ESPNOT,ESPS,ESPTEST,ESPVAR,ESPX,ESPY,I,NOUPD,X,Y,^TMP($JOB)
+2 QUIT
RD SET DIR(0)="912,"_ESPX
DO ^DIR
IF $SELECT(($LENGTH(X)>1&($EXTRACT(X)=U)):1,($LENGTH(X)>1&(X[U)):1,1:0)
DO NO
KILL X,Y
GOTO RD
+1 KILL DIR
QUIT
NO WRITE $CHAR(7),!!?5,"NO '^'S ALLOWED!",!!
QUIT
+1 ;
NOUPD WRITE !!,$CHAR(7),?20,"NO UPDATING HAS OCCURRED!!!",!!
KILL ESPCL,ESPD,ESPDTR,ESPX,ESPY,^TMP($JOB)
if $DATA(DTOUT)
GOTO EXIT
GOTO DTR
MSG WRITE !,$CHAR(7),"FOUND"
WRITE ?10,"There is already a report for this date/time.",!?10,"Same date/time received NOT allowed.",!?10,"To edit the existing report,",!?10,"you must go to the Edit an Offense Report option."
+1 WRITE !?10,"To complete this report, go to Resume an Offense Report Entry."
+2 QUIT
SET(NEWKEY,TYPE) ;PULL BADGE/RANK FOR INVESTIGATOR
+1 if TYPE>0
SET HDA=DA
+2 SET DIC="^VA(200,"
SET DA=NEWKEY
SET DR="910.1;910.2"
SET DIQ(0)="E"
SET DIQ="POLINF"
DO EN^DIQ1
+3 if TYPE>0
SET SX=$SELECT(TYPE=1:POLINF(200,DA,910.1,"E"),TYPE=2:POLINF(200,DA,910.2,"E"),1:"")
SET DI=.06
+4 if TYPE=0
SET ESPD(.11)=POLINF(200,DA,910.1,"E")
SET ESPD(.12)=POLINF(200,DA,910.2,"E")
+5 KILL DIC,DIQ,POLINF
+6 if TYPE=0
QUIT
+7 SET DA=HDA
KILL HDA
+8 QUIT SX
