VistA-WorldVistAEHR/r/POLICE_AND_SECURITY-ES/ESPUVN.m

74 lines
4.3 KiB
Mathematica

ESPUVN ;DALISC/CKA - ENTER U.S. DISTRICT COURT/COURTESY VIOLATION NOTICE;12/17/93
;;1.0;POLICE & SECURITY;**4,35**;Mar 31, 1994
;ESPTYPE="C" FOR COURTESY ESPTYPE="V" FOR USDCVN
TYPE ;IF '$D(ESPTYPE) THEN ASK IF COURTESY OR USDCVN
I '$D(ESPTYPE) D
. 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"""
. D ^DIR K DIR I "CV"[Y S ESPTYPE=Y
I '$D(ESPTYPE) W !!,$C(7),"The program is now exiting!" G EXIT
FAC K DIC S DIC("A")="Select Facility: ",DIC(0)="QAEMZ",DIC="^DG(40.8," D ^DIC
G:$D(DTOUT)!$D(DUOUT)!(+Y'>0) EXIT
S ESPFAC=+Y
D DT^DICRW F I=1:1:13 S ESPD(I)="" S ESPVAR=4
MNI I '$D(ESPFN) W ! D EN^ESPMNI G:'$D(ESPFN) EXIT G:(ESPFN'>0) EXIT
S ESPNAM=$P(^ESP(910,ESPFN,0),U)
I ESPNAM'["UNKNOWN" D DISPL
ADD 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
DTO 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"
D ^DIR K DIR G:$D(DIRUT) EXIT S ESPD(.02)=Y,ESPD(.1)=ESPFAC
OFF S ESPX=".04" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(.04)=+Y S:'+Y ESPD(.02)=""
I ESPTYPE="C" G POL
VIO S ESPX=".05" D RD G:$D(DUOUT) NOUPD S ESPD(.05)=Y
POL S ESPX=".06" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(.06)=+Y S:'+Y ESPD(.06)=""
LOC S ESPX=".07" D RD G:$D(DUOUT) NOUPD S ESPD(.07)=Y
DESC S ESPX=".08" D RD G:$D(DUOUT) NOUPD S ESPD(.08)=Y
DEC S ESPX="1.01" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.01)=+Y S:'+Y ESPD(1.01)=""
DCOL S ESPX="1.02" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.02)=+Y S:'+Y ESPD(1.02)=""
LIC S ESPX="1.03" D RD G:$D(DUOUT) NOUPD S ESPD(1.03)=Y
ST S ESPX="1.04" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.04)=+Y S:'+Y ESPD(1.04)=""
MAKE S ESPX="1.05" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.05)=+Y S:'+Y ESPD(1.05)=""
MOD S ESPX="1.06" D RD G:$D(DUOUT) NOUPD S ESPD(1.06)=Y
STY S ESPX="1.07" D RD G:$D(DUOUT) NOUPD S ESPD(1.07)=Y
VCOL S ESPX="1.08" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(1.08)=+Y S:'+Y ESPD(1.08)=""
YR S ESPX="1.09" D RD G:$D(DUOUT) NOUPD S ESPD(1.09)=Y
I ESPTYPE="C" G UPD
CRT S ESPX="2.01" D RD G:$D(DUOUT) NOUPD S ESPD(2.01)=Y
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
DISP S ESPX="2.02" D RD G:$D(DUOUT) NOUPD S:+Y ESPD(2.02)=+Y S:'+Y ESPD(2.02)=""
RMK W !,"REMARKS: " S DWLW=80,DWPK=1,DIC="^TMP($J," D EN^DIWE
UPD W !!!,"Updating."
STUFF K DD,DO S DIC="^ESP(914,",DIC(0)="L",DLAYGO=914 D VIO^ESPOID D FILE^DICN
S ESPVIO=+Y
L +^ESP(914,ESPVIO):1 I '$T W !,"Another user is editing this record!!"
I ESPTYPE="C" G C
S ^ESP(914,ESPVIO,0)=ESPVIO_"^"_ESPD(.02)_"^V^"_ESPD(.04)_"^"_ESPD(.05)_"^"_ESPD(.06)_"^"_ESPD(.07)_"^"_ESPD(.08)_"^"_ESPFN_"^"_ESPD(.1)
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)
S ^ESP(914,ESPVIO,2)=ESPD(2.01)_"^"_ESPD(2.02),%X="^TMP("_$J_",",%Y="^ESP(914,"_ESPVIO_",10," D %XY^%RCR
S DIK="^ESP(914,",DA=ESPVIO D IX1^DIK K DIK,DD
W !!,"Done."
L -^ESP(914,ESPVIO)
G EXIT
;
C ;STUFF COURTESY VIOLATION
S ^ESP(914,ESPVIO,0)=ESPVIO_"^"_ESPD(.02)_"^C^"_ESPD(.04)_"^^"_ESPD(.06)_"^"_ESPD(.07)_"^"_ESPD(.08)_"^"_ESPFN_"^"_ESPD(.1)
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)
S DIK="^ESP(914,",DA=ESPVIO D IX1^DIK K DIK,DD
W !!,"Done."
L -^ESP(914,ESPVIO)
EXIT K ESPFAC,ESPD,ESPFN,ESPTYPE,ESPVIO,ESPX,^TMP($J)
QUIT
RD 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
K DIR
Q
NO W $C(7),!!?5,"NO '^'S ALLOWED!",!! Q
NOUPD W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPD,ESPX G DTO
DISPL S ESPN=0 I '$O(^ESP(914,"E",ESPFN,ESPN)) W !!,"NO EXISTING VIOLATIONS FOR ",ESPNAM,! Q
W !!,"EXISTING VIOLATIONS FOR ",ESPNAM,!
W "ID#",?15,"DATE/TIME OF OFFENSE",?37,"OFFENSE CHARGED",?70,"TYPE"
F ESPN=0:0 S ESPN=$O(^ESP(914,"E",ESPFN,ESPN)) Q:ESPN="" D
. K ^UTILITY("DIQ1",$J)
. S DIC="^ESP(914,",DR=".01;.02;.04;.03",DA=ESPN,DIQ(0)="IE" D EN^DIQ1
. 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")
. K DA
QUIT