- 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 Feb 18, 2025@23:56:20 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