- ESPORP ;DALISC/CKA - PRINT OFFENSE REPORT;3/99
- ;;1.0;POLICE & SECURITY;**14,17,27,36,39,42**;Mar 31, 1994
- EN ;Entry point to print only completed and nonsensitive reports.
- D DT^DICRW
- OR S DIC(0)="AEMZ",DIC("A")="UOR#: ",DIC("S")="I $D(^(5)),$P(^(5),U,2),'$P(^(5),U,4),$P(^(5),U,5)",DIC="^ESP(912,"
- D ^DIC
- G:$D(DTOUT)!($D(DUOUT))!(X="") EXIT
- I Y<0 W !,$C(7),"UOR# not found. Please try again." G OR
- S ESPDTR=$P(^ESP(912,+Y,0),U,2),ESPID=+Y
- Q S %ZIS="Q" D ^%ZIS G:POP EXIT I '$D(IO("Q")) U IO D START G EXIT
- S ZTRTN="START^ESPORP",ZTSAVE("ESP*")="",ZTDESC="OFFENSE REPORT" D ^%ZTLOAD,HOME^%ZIS G EXIT
- START ; BEGINS THE PRINT OF THIS OFFENSE REPORT
- N ESPFACI
- K ^UTILITY("DIQ1",$J) S (END,PAGE)=0 D HDR G:END EXIT
- S DIC="^ESP(912,",DA=ESPID,DR=".02;.03;.04;.05;.06;.09;.11;.12",DIQ(0)="E" D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J,912,DA)) W !,"RECORD DOESN'T EXIST!" G EXIT
- DTR W !,"DATE/TIME RECEIVED: ",$G(^UTILITY("DIQ1",$J,912,DA,.02,"E"))
- DTO W !,"DATE/TIME OF OFFENSE: ",$G(^UTILITY("DIQ1",$J,912,DA,.03,"E"))
- EDTO W !,"ENDING DATE/TIME OF OFFENSE: ",$G(^UTILITY("DIQ1",$J,912,DA,.09,"E"))
- LOC W !,"LOCATION: ",$G(^UTILITY("DIQ1",$J,912,DA,.04,"E"))
- WEAP W !,"WEAPON USED: ",$G(^UTILITY("DIQ1",$J,912,DA,.05,"E"))
- PO W !,"INVESTIGATING OFFICER: ",$G(^UTILITY("DIQ1",$J,912,DA,.06,"E"))
- S BADGE=^UTILITY("DIQ1",$J,912,DA,.11,"E")
- MO K ^UTILITY($J,"W") S DIWL=3,DIWR=78,DIWF="W",IEN=0
- W !,"METHOD OF OPERATION: ",!
- F ESPN=1:1 S IEN=$O(^ESP(912,ESPID,60,IEN)) Q:IEN'>0 S X=^(IEN,0) D G EXIT:END
- . D HDR:$Y+2>IOSL Q:END
- . D ^DIWP
- D MIN(2) Q:END
- D ^DIWW
- CL ;PRINT CLASSIFICATION CODES, TYPES, AND SUBTYPES
- F ESPN=0:0 S ESPN=$O(^ESP(912,ESPID,10,ESPN)) Q:ESPN'>0 D G EXIT:END
- . S DIC="^ESP(912,"_ESPID_",10,",DA=ESPN,DR=".01;.02;.03",DIQ(0)="E" D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
- . D LINES()
- . W "CLASSIFICATION CODE: ",$G(^UTILITY("DIQ1",$J,912.01,DA,.01,"E"))
- . I $G(^UTILITY("DIQ1",$J,912.01,DA,.02,"E"))]"" W "/",^("E")
- . I $G(^UTILITY("DIQ1",$J,912.01,DA,.03,"E"))]"" W "/",^("E")
- G ^ESPORP1
- EXIT K %ZIS,CL,DA,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,END,ESPDTR,ESPID,ESPN,ESPN1,IEN,PAGE,X,Y,ZTDESC,ZTRTN,ZTSAVE,BADGE
- K ^UTILITY("DIQ1",$J)
- QUIT
- HDR ;PRINT HEADING
- I PAGE>0,$E(IOST,1,2)="C-" S END=$$EOP^ESPUTIL() Q:END
- S PAGE=PAGE+1 W:PAGE'=1 @IOF W !?25,"DEPARTMENT OF VETERANS AFFAIRS",?(IOM-10),"Page ",$J(PAGE,3)
- W !?35,"VA POLICE",!?28,"UNIFORM OFFENSE REPORT"
- W !?30,"UOR# ",$E(ESPDTR,2,3),"-",$E(ESPDTR,4,5),"-",$E(ESPDTR,6,7),"-",$TR($E($P(ESPDTR,".",2)_"ZZZZ",1,4),"Z",0)
- W !!,"VA Facility" W ?61,"Date/Time Printed"
- S ESPFACI=$P(^ESP(912,ESPID,0),U,7) S ESPFACI=$S(ESPFACI="":"",$D(^DG(40.8,ESPFACI,0)):$P(^(0),U),1:"")
- I ESPFACI="",$D(^ESP(912,ESPID,5)),$P(^(5),U)'="" S ESPFACI=$S($D(^DIC(4,$P(^(5),U),0)):$P(^(0),U),1:"")
- W !,ESPFACI
- W ?61,$$NOW^ESPUTIL()
- W !,"Automated VA Form 10-1393"
- W !!
- QUIT
- ;
- ;ENTRY POINT OR1 IS TO ALLOWS PRINT OF AN INCOMPLETE REPORT
- ;THIS OPTION IS ONLY FOR PERSONS HOLDING THE CHIEF KEY
- OR1 S DIC(0)="AEMZ",DIC("A")="UOR#: ",DIC("S")="I $D(^(5)),$P(^(5),U,5)",DIC="^ESP(912,"
- D ^DIC G:$D(DTOUT)!($D(DUOUT))!(X="") EXIT G:Y<0 OR1 S ESPDTR=$P(^ESP(912,+Y,0),U,2),ESPID=+Y
- D Q
- QUIT
- ;
- LINES(COUNT) ;
- ;writes COUNT lines
- ;writes header if necessary
- ;
- N CRT,INDEX
- I '$D(COUNT) S COUNT=1
- S CRT=$S(($E(IOST,1,2)="C-"):1,1:0)
- F INDEX=1:1:COUNT D Q:END
- .I $Y>(IOSL-(1+CRT)) D HDR Q:END
- .W !
- Q
- ;
- MIN(COUNT) ;
- ;prints header if not minimum of COUNT pages left
- ;first gives end of page message if crt
- ;
- N CRT
- S CRT=$S(($E(IOST,1,2)="C-"):1,1:0)
- S COUNT=COUNT+CRT
- I ($Y>(IOSL-(COUNT))) D HDR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPORP 3691 printed Jan 18, 2025@03:31:16 Page 2
- ESPORP ;DALISC/CKA - PRINT OFFENSE REPORT;3/99
- +1 ;;1.0;POLICE & SECURITY;**14,17,27,36,39,42**;Mar 31, 1994
- EN ;Entry point to print only completed and nonsensitive reports.
- +1 DO DT^DICRW
- OR SET DIC(0)="AEMZ"
- SET DIC("A")="UOR#: "
- SET DIC("S")="I $D(^(5)),$P(^(5),U,2),'$P(^(5),U,4),$P(^(5),U,5)"
- SET DIC="^ESP(912,"
- +1 DO ^DIC
- +2 if $DATA(DTOUT)!($DATA(DUOUT))!(X="")
- GOTO EXIT
- +3 IF Y<0
- WRITE !,$CHAR(7),"UOR# not found. Please try again."
- GOTO OR
- +4 SET ESPDTR=$PIECE(^ESP(912,+Y,0),U,2)
- SET ESPID=+Y
- Q SET %ZIS="Q"
- DO ^%ZIS
- if POP
- GOTO EXIT
- IF '$DATA(IO("Q"))
- USE IO
- DO START
- GOTO EXIT
- +1 SET ZTRTN="START^ESPORP"
- SET ZTSAVE("ESP*")=""
- SET ZTDESC="OFFENSE REPORT"
- DO ^%ZTLOAD
- DO HOME^%ZIS
- GOTO EXIT
- START ; BEGINS THE PRINT OF THIS OFFENSE REPORT
- +1 NEW ESPFACI
- +2 KILL ^UTILITY("DIQ1",$JOB)
- SET (END,PAGE)=0
- DO HDR
- if END
- GOTO EXIT
- +3 SET DIC="^ESP(912,"
- SET DA=ESPID
- SET DR=".02;.03;.04;.05;.06;.09;.11;.12"
- SET DIQ(0)="E"
- DO EN^DIQ1
- IF '$DATA(^UTILITY("DIQ1",$JOB,912,DA))
- WRITE !,"RECORD DOESN'T EXIST!"
- GOTO EXIT
- DTR WRITE !,"DATE/TIME RECEIVED: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.02,"E"))
- DTO WRITE !,"DATE/TIME OF OFFENSE: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.03,"E"))
- EDTO WRITE !,"ENDING DATE/TIME OF OFFENSE: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.09,"E"))
- LOC WRITE !,"LOCATION: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.04,"E"))
- WEAP WRITE !,"WEAPON USED: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.05,"E"))
- PO WRITE !,"INVESTIGATING OFFICER: ",$GET(^UTILITY("DIQ1",$JOB,912,DA,.06,"E"))
- +1 SET BADGE=^UTILITY("DIQ1",$JOB,912,DA,.11,"E")
- MO KILL ^UTILITY($JOB,"W")
- SET DIWL=3
- SET DIWR=78
- SET DIWF="W"
- SET IEN=0
- +1 WRITE !,"METHOD OF OPERATION: ",!
- +2 FOR ESPN=1:1
- SET IEN=$ORDER(^ESP(912,ESPID,60,IEN))
- if IEN'>0
- QUIT
- SET X=^(IEN,0)
- Begin DoDot:1
- +3 if $Y+2>IOSL
- DO HDR
- if END
- QUIT
- +4 DO ^DIWP
- End DoDot:1
- if END
- GOTO EXIT
- +5 DO MIN(2)
- if END
- QUIT
- +6 DO ^DIWW
- CL ;PRINT CLASSIFICATION CODES, TYPES, AND SUBTYPES
- +1 FOR ESPN=0:0
- SET ESPN=$ORDER(^ESP(912,ESPID,10,ESPN))
- if ESPN'>0
- QUIT
- Begin DoDot:1
- +2 SET DIC="^ESP(912,"_ESPID_",10,"
- SET DA=ESPN
- SET DR=".01;.02;.03"
- SET DIQ(0)="E"
- DO EN^DIQ1
- if '$DATA(^UTILITY("DIQ1",$JOB,912.01,DA,.01,"E"))
- QUIT
- +3 DO LINES()
- +4 WRITE "CLASSIFICATION CODE: ",$GET(^UTILITY("DIQ1",$JOB,912.01,DA,.01,"E"))
- +5 IF $GET(^UTILITY("DIQ1",$JOB,912.01,DA,.02,"E"))]""
- WRITE "/",^("E")
- +6 IF $GET(^UTILITY("DIQ1",$JOB,912.01,DA,.03,"E"))]""
- WRITE "/",^("E")
- End DoDot:1
- if END
- GOTO EXIT
- +7 GOTO ^ESPORP1
- EXIT KILL %ZIS,CL,DA,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,END,ESPDTR,ESPID,ESPN,ESPN1,IEN,PAGE,X,Y,ZTDESC,ZTRTN,ZTSAVE,BADGE
- +1 KILL ^UTILITY("DIQ1",$JOB)
- +2 QUIT
- HDR ;PRINT HEADING
- +1 IF PAGE>0
- IF $EXTRACT(IOST,1,2)="C-"
- SET END=$$EOP^ESPUTIL()
- if END
- QUIT
- +2 SET PAGE=PAGE+1
- if PAGE'=1
- WRITE @IOF
- WRITE !?25,"DEPARTMENT OF VETERANS AFFAIRS",?(IOM-10),"Page ",$JUSTIFY(PAGE,3)
- +3 WRITE !?35,"VA POLICE",!?28,"UNIFORM OFFENSE REPORT"
- +4 WRITE !?30,"UOR# ",$EXTRACT(ESPDTR,2,3),"-",$EXTRACT(ESPDTR,4,5),"-",$EXTRACT(ESPDTR,6,7),"-",$TRANSLATE($EXTRACT($PIECE(ESPDTR,".",2)_"ZZZZ",1,4),"Z",0)
- +5 WRITE !!,"VA Facility"
- WRITE ?61,"Date/Time Printed"
- +6 SET ESPFACI=$PIECE(^ESP(912,ESPID,0),U,7)
- SET ESPFACI=$SELECT(ESPFACI="":"",$DATA(^DG(40.8,ESPFACI,0)):$PIECE(^(0),U),1:"")
- +7 IF ESPFACI=""
- IF $DATA(^ESP(912,ESPID,5))
- IF $PIECE(^(5),U)'=""
- SET ESPFACI=$SELECT($DATA(^DIC(4,$PIECE(^(5),U),0)):$PIECE(^(0),U),1:"")
- +8 WRITE !,ESPFACI
- +9 WRITE ?61,$$NOW^ESPUTIL()
- +10 WRITE !,"Automated VA Form 10-1393"
- +11 WRITE !!
- +12 QUIT
- +13 ;
- +14 ;ENTRY POINT OR1 IS TO ALLOWS PRINT OF AN INCOMPLETE REPORT
- +15 ;THIS OPTION IS ONLY FOR PERSONS HOLDING THE CHIEF KEY
- OR1 SET DIC(0)="AEMZ"
- SET DIC("A")="UOR#: "
- SET DIC("S")="I $D(^(5)),$P(^(5),U,5)"
- SET DIC="^ESP(912,"
- +1 DO ^DIC
- if $DATA(DTOUT)!($DATA(DUOUT))!(X="")
- GOTO EXIT
- if Y<0
- GOTO OR1
- SET ESPDTR=$PIECE(^ESP(912,+Y,0),U,2)
- SET ESPID=+Y
- +2 DO Q
- +3 QUIT
- +4 ;
- LINES(COUNT) ;
- +1 ;writes COUNT lines
- +2 ;writes header if necessary
- +3 ;
- +4 NEW CRT,INDEX
- +5 IF '$DATA(COUNT)
- SET COUNT=1
- +6 SET CRT=$SELECT(($EXTRACT(IOST,1,2)="C-"):1,1:0)
- +7 FOR INDEX=1:1:COUNT
- Begin DoDot:1
- +8 IF $Y>(IOSL-(1+CRT))
- DO HDR
- if END
- QUIT
- +9 WRITE !
- End DoDot:1
- if END
- QUIT
- +10 QUIT
- +11 ;
- MIN(COUNT) ;
- +1 ;prints header if not minimum of COUNT pages left
- +2 ;first gives end of page message if crt
- +3 ;
- +4 NEW CRT
- +5 SET CRT=$SELECT(($EXTRACT(IOST,1,2)="C-"):1,1:0)
- +6 SET COUNT=COUNT+CRT
- +7 IF ($Y>(IOSL-(COUNT)))
- DO HDR
- +8 QUIT