source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPUVN.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1ESPUVN ;DALISC/CKA - ENTER U.S. DISTRICT COURT/COURTESY VIOLATION NOTICE;12/17/93
2 ;;1.0;POLICE & SECURITY;**4,35**;Mar 31, 1994
3 ;ESPTYPE="C" FOR COURTESY ESPTYPE="V" FOR USDCVN
4TYPE ;IF '$D(ESPTYPE) THEN ASK IF COURTESY OR USDCVN
5 I '$D(ESPTYPE) D
6 . S DIR(0)="S^C:COURTESY;V:USDC",DIR("A")="Is this a courtesy or USDC violation",DIR("?")="^W !,?10,""Enter C for COURTESY or V for USDC violation"""
7 . D ^DIR K DIR I "CV"[Y S ESPTYPE=Y
8 I '$D(ESPTYPE) W !!,$C(7),"The program is now exiting!" G EXIT
9FAC K DIC S DIC("A")="Select Facility: ",DIC(0)="QAEMZ",DIC="^DG(40.8," D ^DIC
10 G:$D(DTOUT)!$D(DUOUT)!(+Y'>0) EXIT
11 S ESPFAC=+Y
12 D DT^DICRW F I=1:1:13 S ESPD(I)="" S ESPVAR=4
13MNI I '$D(ESPFN) W ! D EN^ESPMNI G:'$D(ESPFN) EXIT G:(ESPFN'>0) EXIT
14 S ESPNAM=$P(^ESP(910,ESPFN,0),U)
15 I ESPNAM'["UNKNOWN" D DISPL
16ADD S DIR(0)="Y",DIR("A")="Do you want to add a new violation",DIR("B")="YES" D ^DIR K DIR I 'Y K ESPFN G MNI
17DTO W !! S DIR(0)="DO^:-NOW:ETXR",DIR("A")="DATE/TIME OF OFFENSE",DIR("?")="^W !!,?10,""Enter the date and time of the offense. Future dates not allowed."" S %DT=""ETXR"" D HELP^%DTC"
18 D ^DIR K DIR G:$D(DIRUT) EXIT S ESPD(.02)=Y,ESPD(.1)=ESPFAC
19OFF S ESPX=".04" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(.04)=+Y S:'+Y ESPD(.02)=""
20 I ESPTYPE="C" G POL
21VIO S ESPX=".05" D RD G:$D(DUOUT) NOUPD S ESPD(.05)=Y
22POL S ESPX=".06" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(.06)=+Y S:'+Y ESPD(.06)=""
23LOC S ESPX=".07" D RD G:$D(DUOUT) NOUPD S ESPD(.07)=Y
24DESC S ESPX=".08" D RD G:$D(DUOUT) NOUPD S ESPD(.08)=Y
25DEC S ESPX="1.01" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.01)=+Y S:'+Y ESPD(1.01)=""
26DCOL S ESPX="1.02" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.02)=+Y S:'+Y ESPD(1.02)=""
27LIC S ESPX="1.03" D RD G:$D(DUOUT) NOUPD S ESPD(1.03)=Y
28ST S ESPX="1.04" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.04)=+Y S:'+Y ESPD(1.04)=""
29MAKE S ESPX="1.05" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.05)=+Y S:'+Y ESPD(1.05)=""
30MOD S ESPX="1.06" D RD G:$D(DUOUT) NOUPD S ESPD(1.06)=Y
31STY S ESPX="1.07" D RD G:$D(DUOUT) NOUPD S ESPD(1.07)=Y
32VCOL S ESPX="1.08" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.08)=+Y S:'+Y ESPD(1.08)=""
33YR S ESPX="1.09" D RD G:$D(DUOUT) NOUPD S ESPD(1.09)=Y
34 I ESPTYPE="C" G UPD
35CRT S ESPX="2.01" D RD G:$D(DUOUT) NOUPD S ESPD(2.01)=Y
36 I ESPD(2.01)<ESPD(.02),ESPD(2.01)'="" W !?5,$C(7),"Court Date must be after the Date/Time of Offense!" G CRT
37DISP S ESPX="2.02" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(2.02)=+Y S:'+Y ESPD(2.02)=""
38RMK W !,"REMARKS: " S DWLW=80,DWPK=1,DIC="^TMP($J," D EN^DIWE
39UPD W !!!,"Updating."
40STUFF K DD,DO S DIC="^ESP(914,",DIC(0)="L",DLAYGO=914 D VIO^ESPOID D FILE^DICN
41 S ESPVIO=+Y
42 L +^ESP(914,ESPVIO):1 I '$T W !,"Another user is editing this record!!"
43 I ESPTYPE="C" G C
44 S ^ESP(914,ESPVIO,0)=ESPVIO_"^"_ESPD(.02)_"^V^"_ESPD(.04)_"^"_ESPD(.05)_"^"_ESPD(.06)_"^"_ESPD(.07)_"^"_ESPD(.08)_"^"_ESPFN_"^"_ESPD(.1)
45 S ^ESP(914,ESPVIO,1)=ESPD(1.01)_"^"_ESPD(1.02)_"^"_ESPD(1.03)_"^"_ESPD(1.04)_"^"_ESPD(1.05)_"^"_ESPD(1.06)_"^"_ESPD(1.07)_"^"_ESPD(1.08)_"^"_ESPD(1.09)
46 S ^ESP(914,ESPVIO,2)=ESPD(2.01)_"^"_ESPD(2.02),%X="^TMP("_$J_",",%Y="^ESP(914,"_ESPVIO_",10," D %XY^%RCR
47 S DIK="^ESP(914,",DA=ESPVIO D IX1^DIK K DIK,DD
48 W !!,"Done."
49 L -^ESP(914,ESPVIO)
50 G EXIT
51 ;
52C ;STUFF COURTESY VIOLATION
53 S ^ESP(914,ESPVIO,0)=ESPVIO_"^"_ESPD(.02)_"^C^"_ESPD(.04)_"^^"_ESPD(.06)_"^"_ESPD(.07)_"^"_ESPD(.08)_"^"_ESPFN_"^"_ESPD(.1)
54 S ^ESP(914,ESPVIO,1)=ESPD(1.01)_"^"_ESPD(1.02)_"^"_ESPD(1.03)_"^"_ESPD(1.04)_"^"_ESPD(1.05)_"^"_ESPD(1.06)_"^"_ESPD(1.07)_"^"_ESPD(1.08)_"^"_ESPD(1.09)
55 S DIK="^ESP(914,",DA=ESPVIO D IX1^DIK K DIK,DD
56 W !!,"Done."
57 L -^ESP(914,ESPVIO)
58EXIT K ESPFAC,ESPD,ESPFN,ESPTYPE,ESPVIO,ESPX,^TMP($J)
59 QUIT
60RD S DIR(0)="914,"_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
61 K DIR
62 Q
63NO W $C(7),!!?5,"NO '^'S ALLOWED!",!! Q
64NOUPD W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPD,ESPX G DTO
65DISPL S ESPN=0 I '$O(^ESP(914,"E",ESPFN,ESPN)) W !!,"NO EXISTING VIOLATIONS FOR ",ESPNAM,! Q
66 W !!,"EXISTING VIOLATIONS FOR ",ESPNAM,!
67 W "ID#",?15,"DATE/TIME OF OFFENSE",?37,"OFFENSE CHARGED",?70,"TYPE"
68 F ESPN=0:0 S ESPN=$O(^ESP(914,"E",ESPFN,ESPN)) Q:ESPN="" D
69 . K ^UTILITY("DIQ1",$J)
70 . S DIC="^ESP(914,",DR=".01;.02;.04;.03",DA=ESPN,DIQ(0)="IE" D EN^DIQ1
71 . W !,^UTILITY("DIQ1",$J,914,DA,.01,"E"),?15,^UTILITY("DIQ1",$J,914,DA,.02,"E"),?37,^UTILITY("DIQ1",$J,914,DA,.04,"E"),?70,^UTILITY("DIQ1",$J,914,DA,.03,"E")
72 . K DA
73 QUIT
Note: See TracBrowser for help on using the repository browser.