- ESPOFF1 ;DALISC/CKA - OFFENSE REPORT INPUT - PART 2;9/92
- ;;1.0;POLICE & SECURITY;**39**;Mar 31, 1994
- EN ;Q; Requires ^TMP($J) to be defined
- W !!!,"Updating."
- STUFF K DD,DO S DIC="^ESP(912,",DIC(0)="L",DLAYGO=912 D OFF^ESPOID D FILE^DICN S ESPOFN=+Y
- L +^ESP(912,ESPOFN):1 I '$T W !,"Another user is editing this record!!"
- S UOR0=^TMP($J,"UOR",0)
- S ^ESP(912,ESPOFN,0)=ESPOFN_"^"_$P(UOR0,U,2,12),^ESP(912,ESPOFN,1)=$G(^TMP($J,"UOR",1))
- S $P(^ESP(912,ESPOFN,5),U,2)=0,$P(^ESP(912,ESPOFN,5),U,3)=DUZ,$P(^(5),U,5)=1
- CL ;STUFF CLASSIFICATION CODES
- F ESPN=0:0 S ESPN=$O(^TMP($J,"UOR","CL",ESPN)) Q:ESPN="" S CL=^(ESPN,0) D
- . S:'$D(^ESP(912,ESPOFN,10,0)) ^(0)="^912.01P^^"
- . K DD,DO S DIC="^ESP(912,"_ESPOFN_",10,",DIC(0)="L",DLAYGO=912,X=+CL,DA(1)=ESPOFN D FILE^DICN
- . S ^ESP(912,ESPOFN,10,ESPN,0)=CL
- . ;X-REF
- . S DIK="^ESP(912,"_ESPOFN_",20,",DA=ESPN D IX1^DIK K DIK,DA
- C ;STUFF COMPLAINANT DATA
- F ESPN=0:0 S ESPN=$O(^TMP($J,"UOR","C",ESPN)) Q:ESPN="" S ESPFN=^(ESPN) D
- . S:'$D(^ESP(912,ESPOFN,20,0)) ^(0)="^912.03^" K DD,DO S DIC="^ESP(912,"_ESPOFN_",20,",DIC(0)="L",DLAYGO=912,X=ESPN,DA(1)=ESPOFN D FILE^DICN
- . S COMP0=$G(^ESP(910,ESPFN,0)),^ESP(912,ESPOFN,20,ESPN,0)=ESPN_"^"_ESPFN_"^"_$P(COMP0,U,4),^ESP(912,ESPOFN,20,ESPN,1)=$G(^ESP(910,ESPFN,1)),^ESP(912,ESPOFN,20,ESPN,2)=$G(^ESP(910,ESPFN,2))
- . S DIK="^ESP(912,"_ESPOFN_",20,",DA=ESPN D IX1^DIK K DIK,DA
- V ;STUFF VICTIM DATA
- F ESPN=0:0 S ESPN=$O(^TMP($J,"UOR","V",ESPN)) Q:ESPN="" S ESPFN=^(ESPN) D
- . S:'$D(^ESP(912,ESPOFN,30,0)) ^(0)="^912.04^"
- . K DD,DO S DIC="^ESP(912,"_ESPOFN_",30,",DIC(0)="L",DLAYGO=912,X=ESPN,DA(1)=ESPOFN D FILE^DICN
- . S VIC0=$G(^ESP(910,ESPFN,0)),^ESP(912,ESPOFN,30,ESPN,0)=ESPN_"^"_ESPFN_"^"_$P(VIC0,U,8)_"^"_$P(VIC0,U,9)_"^"_$P(VIC0,U,4)_"^"_$P(VIC0,U,10)_"^"_$P(VIC0,U,11)
- . S ^ESP(912,ESPOFN,30,ESPN,1)=$G(^ESP(910,ESPFN,1))
- . S ^ESP(912,ESPOFN,30,ESPN,2)=$G(^ESP(910,ESPFN,2))
- . ;MEDICAL TREATMENT
- . S %X="^TMP("_$J_",""MT"","_ESPN_",",%Y="^ESP(912,"_ESPOFN_",30,"_ESPN_",10," D %XY^%RCR
- . ;X REF
- . S DIK="^ESP(912,"_ESPOFN_",30,",DA=ESPN D IX1^DIK K DIK,DA
- O ;STUFF OFFENDER DATA
- F ESPN=0:0 S ESPN=$O(^TMP($J,"UOR","O",ESPN)) Q:ESPN="" S ESPFN=+^(ESPN),TMPN=^(ESPN) D
- . S:'$D(^ESP(912,ESPOFN,40,0)) ^(0)="^912.05^"
- . K DD,DO S DIC="^ESP(912,"_ESPOFN_",40,",DIC(0)="L",DLAYGO=912,X=ESPN,DA(1)=ESPOFN D FILE^DICN
- . I ESPFN>0 D
- .. S OFF0=$G(^ESP(910,ESPFN,0)),OFF3=$G(^(3))
- .. S ^ESP(912,ESPOFN,40,ESPN,0)=ESPN_"^"_ESPFN_"^"_$P(OFF0,U,8)_"^"_$P(OFF0,U,9)_"^"_$P(OFF3,U,1)_"^"_$P(OFF3,U,2)_"^"_$P(OFF3,U,3)_"^"_$P(OFF3,U,4)_"^"_$P(OFF3,U,5)_"^"_$P(OFF3,U,6)_"^"_$P(OFF0,U,4)_"^"_$P(OFF0,U,10)_"^"_$P(OFF0,U,11)
- .. S ^ESP(912,ESPOFN,40,ESPN,1)=$G(^ESP(910,ESPFN,1)),^ESP(912,ESPOFN,40,ESPN,2)=$G(^ESP(910,ESPFN,2)),^ESP(912,ESPOFN,40,ESPN,3)=^TMP($J,"UOR","OPERS",ESPN)
- . E D
- .. S ^ESP(912,ESPOFN,40,ESPN,0)=ESPN_"^^^"_$P(TMPN,U,4)_"^"_$P(TMPN,U,5)_"^"_$P(TMPN,U,6)_"^"_$P(TMPN,U,7)_"^"_$P(TMPN,U,8)_"^"_$P(TMPN,U,9)_"^"_$P(TMPN,U,10),^ESP(912,ESPOFN,40,ESPN,3)=^TMP($J,"UOR","OPERS",ESPN)
- . ;STUFF OFFENSE CHARGED
- . F ESPN1=0:0 S ESPN1=$O(^TMP($J,"UOR","O",ESPN,ESPN1)) Q:ESPN1="" S OFF(ESPN1)=^(ESPN1,0) D
- .. S:'$D(^ESP(912,ESPOFN,40,ESPN,10,0)) ^(0)="^912.11P^^"
- .. K DD,DO S DIC="^ESP(912,"_ESPOFN_",40,"_ESPN_",10,",DIC(0)="L",DLAYGO=912,DA(2)=ESPOFN,DA(1)=ESPN,DA=ESPN1,X=+^TMP($J,"UOR","O",ESPN,ESPN1,0) D FILE^DICN
- .. S $P(^ESP(912,ESPOFN,40,ESPN,10,DA,0),U,2,4)=$P(OFF(ESPN1),U,2,4)
- . ;X-REF
- . S DIK="^ESP(912,"_ESPOFN_",40,",DA(1)=ESPN,DA=ESPOFN D IX1^DIK K DIK,DA
- ;
- ;
- G ^ESPOFF2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPOFF1 3603 printed Feb 18, 2025@23:56:22 Page 2
- ESPOFF1 ;DALISC/CKA - OFFENSE REPORT INPUT - PART 2;9/92
- +1 ;;1.0;POLICE & SECURITY;**39**;Mar 31, 1994
- EN ;Q; Requires ^TMP($J) to be defined
- +1 WRITE !!!,"Updating."
- STUFF KILL DD,DO
- SET DIC="^ESP(912,"
- SET DIC(0)="L"
- SET DLAYGO=912
- DO OFF^ESPOID
- DO FILE^DICN
- SET ESPOFN=+Y
- +1 LOCK +^ESP(912,ESPOFN):1
- IF '$TEST
- WRITE !,"Another user is editing this record!!"
- +2 SET UOR0=^TMP($JOB,"UOR",0)
- +3 SET ^ESP(912,ESPOFN,0)=ESPOFN_"^"_$PIECE(UOR0,U,2,12)
- SET ^ESP(912,ESPOFN,1)=$GET(^TMP($JOB,"UOR",1))
- +4 SET $PIECE(^ESP(912,ESPOFN,5),U,2)=0
- SET $PIECE(^ESP(912,ESPOFN,5),U,3)=DUZ
- SET $PIECE(^(5),U,5)=1
- CL ;STUFF CLASSIFICATION CODES
- +1 FOR ESPN=0:0
- SET ESPN=$ORDER(^TMP($JOB,"UOR","CL",ESPN))
- if ESPN=""
- QUIT
- SET CL=^(ESPN,0)
- Begin DoDot:1
- +2 if '$DATA(^ESP(912,ESPOFN,10,0))
- SET ^(0)="^912.01P^^"
- +3 KILL DD,DO
- SET DIC="^ESP(912,"_ESPOFN_",10,"
- SET DIC(0)="L"
- SET DLAYGO=912
- SET X=+CL
- SET DA(1)=ESPOFN
- DO FILE^DICN
- +4 SET ^ESP(912,ESPOFN,10,ESPN,0)=CL
- +5 ;X-REF
- +6 SET DIK="^ESP(912,"_ESPOFN_",20,"
- SET DA=ESPN
- DO IX1^DIK
- KILL DIK,DA
- End DoDot:1
- C ;STUFF COMPLAINANT DATA
- +1 FOR ESPN=0:0
- SET ESPN=$ORDER(^TMP($JOB,"UOR","C",ESPN))
- if ESPN=""
- QUIT
- SET ESPFN=^(ESPN)
- Begin DoDot:1
- +2 if '$DATA(^ESP(912,ESPOFN,20,0))
- SET ^(0)="^912.03^"
- KILL DD,DO
- SET DIC="^ESP(912,"_ESPOFN_",20,"
- SET DIC(0)="L"
- SET DLAYGO=912
- SET X=ESPN
- SET DA(1)=ESPOFN
- DO FILE^DICN
- +3 SET COMP0=$GET(^ESP(910,ESPFN,0))
- SET ^ESP(912,ESPOFN,20,ESPN,0)=ESPN_"^"_ESPFN_"^"_$PIECE(COMP0,U,4)
- SET ^ESP(912,ESPOFN,20,ESPN,1)=$GET(^ESP(910,ESPFN,1))
- SET ^ESP(912,ESPOFN,20,ESPN,2)=$GET(^ESP(910,ESPFN,2))
- +4 SET DIK="^ESP(912,"_ESPOFN_",20,"
- SET DA=ESPN
- DO IX1^DIK
- KILL DIK,DA
- End DoDot:1
- V ;STUFF VICTIM DATA
- +1 FOR ESPN=0:0
- SET ESPN=$ORDER(^TMP($JOB,"UOR","V",ESPN))
- if ESPN=""
- QUIT
- SET ESPFN=^(ESPN)
- Begin DoDot:1
- +2 if '$DATA(^ESP(912,ESPOFN,30,0))
- SET ^(0)="^912.04^"
- +3 KILL DD,DO
- SET DIC="^ESP(912,"_ESPOFN_",30,"
- SET DIC(0)="L"
- SET DLAYGO=912
- SET X=ESPN
- SET DA(1)=ESPOFN
- DO FILE^DICN
- +4 SET VIC0=$GET(^ESP(910,ESPFN,0))
- SET ^ESP(912,ESPOFN,30,ESPN,0)=ESPN_"^"_ESPFN_"^"_$PIECE(VIC0,U,8)_"^"_$PIECE(VIC0,U,9)_"^"_$PIECE(VIC0,U,4)_"^"_$PIECE(VIC0,U,10)_"^"_$PIECE(VIC0,U,11)
- +5 SET ^ESP(912,ESPOFN,30,ESPN,1)=$GET(^ESP(910,ESPFN,1))
- +6 SET ^ESP(912,ESPOFN,30,ESPN,2)=$GET(^ESP(910,ESPFN,2))
- +7 ;MEDICAL TREATMENT
- +8 SET %X="^TMP("_$JOB_",""MT"","_ESPN_","
- SET %Y="^ESP(912,"_ESPOFN_",30,"_ESPN_",10,"
- DO %XY^%RCR
- +9 ;X REF
- +10 SET DIK="^ESP(912,"_ESPOFN_",30,"
- SET DA=ESPN
- DO IX1^DIK
- KILL DIK,DA
- End DoDot:1
- O ;STUFF OFFENDER DATA
- +1 FOR ESPN=0:0
- SET ESPN=$ORDER(^TMP($JOB,"UOR","O",ESPN))
- if ESPN=""
- QUIT
- SET ESPFN=+^(ESPN)
- SET TMPN=^(ESPN)
- Begin DoDot:1
- +2 if '$DATA(^ESP(912,ESPOFN,40,0))
- SET ^(0)="^912.05^"
- +3 KILL DD,DO
- SET DIC="^ESP(912,"_ESPOFN_",40,"
- SET DIC(0)="L"
- SET DLAYGO=912
- SET X=ESPN
- SET DA(1)=ESPOFN
- DO FILE^DICN
- +4 IF ESPFN>0
- Begin DoDot:2
- +5 SET OFF0=$GET(^ESP(910,ESPFN,0))
- SET OFF3=$GET(^(3))
- +6 SET ^ESP(912,ESPOFN,40,ESPN,0)=ESPN_"^"_ESPFN_"^"_$PIECE(OFF0,U,8)_"^"_$PIECE(OFF0,U,9)_"^"_$PIECE(OFF3,U,1)_"^"_$PIECE(OFF3,U,2)_"^"_...
- ... $PIECE(OFF3,U,3)_"^"_$PIECE(OFF3,U,4)_"^"_$PIECE(OFF3,U,5)_"^"_$PIECE(OFF3,U,6)_"^"_$PIECE(OFF0,U,4)_"^"_$PIECE(OFF0,U,10)_"^"_$PIECE(OFF0,U,11)
- +7 SET ^ESP(912,ESPOFN,40,ESPN,1)=$GET(^ESP(910,ESPFN,1))
- SET ^ESP(912,ESPOFN,40,ESPN,2)=$GET(^ESP(910,ESPFN,2))
- SET ^ESP(912,ESPOFN,40,ESPN,3)=^TMP($JOB,"UOR","OPERS",ESPN)
- End DoDot:2
- +8 IF '$TEST
- Begin DoDot:2
- +9 SET ^ESP(912,ESPOFN,40,ESPN,0)=ESPN_"^^^"_$PIECE(TMPN,U,4)_"^"_$PIECE(TMPN,U,5)_"^"_$PIECE(TMPN,U,6)_"^"_$PIECE(TMPN,U,7)_"^"_$PIECE(TMPN,U,8)_"^"_$PIECE(TMPN,U,9)_"^"_$PIECE(TMPN,U,10)
- SET ^ESP(912,ESPOFN,40,ESPN,3)=^TMP($JOB,"UOR","OPERS",ESPN)
- End DoDot:2
- +10 ;STUFF OFFENSE CHARGED
- +11 FOR ESPN1=0:0
- SET ESPN1=$ORDER(^TMP($JOB,"UOR","O",ESPN,ESPN1))
- if ESPN1=""
- QUIT
- SET OFF(ESPN1)=^(ESPN1,0)
- Begin DoDot:2
- +12 if '$DATA(^ESP(912,ESPOFN,40,ESPN,10,0))
- SET ^(0)="^912.11P^^"
- +13 KILL DD,DO
- SET DIC="^ESP(912,"_ESPOFN_",40,"_ESPN_",10,"
- SET DIC(0)="L"
- SET DLAYGO=912
- SET DA(2)=ESPOFN
- SET DA(1)=ESPN
- SET DA=ESPN1
- SET X=+^TMP($JOB,"UOR","O",ESPN,ESPN1,0)
- DO FILE^DICN
- +14 SET $PIECE(^ESP(912,ESPOFN,40,ESPN,10,DA,0),U,2,4)=$PIECE(OFF(ESPN1),U,2,4)
- End DoDot:2
- +15 ;X-REF
- +16 SET DIK="^ESP(912,"_ESPOFN_",40,"
- SET DA(1)=ESPN
- SET DA=ESPOFN
- DO IX1^DIK
- KILL DIK,DA
- End DoDot:1
- +17 ;
- +18 ;
- +19 GOTO ^ESPOFF2