ESPVREG ;DALISC/CKA - VEHICLE REGISTRATION INPUT;3/99
;;1.0;POLICE & SECURITY;**12,27**;Mar 31, 1994
EN ;
D DT^DICRW S ESPRT(1)=1 F I=1:1:13 S ESPD(I)=""
NAM I '$D(ESPFN) W ! S ESPVAR=2 D EN^ESPMNI G:'$D(ESPFN)!($D(DTOUT)) EXIT S ESPNAM=$P(^ESP(910,ESPFN,0),U)
NUM W ! S DIR(0)="FO^1:30",DIR("A")="DECAL",DIR("?")="Enter the Decal # (ex. 9999)",DIR("??")="^S D=""B"",DZ=""??"",DIC=""^ESP(910.2,"",DIC(0)=""AEQZ"",DIC(""S"")=""I $P(^(0),U,4)=1&($P(^(0),U,3)=ESPFN)"" D DQ^DICQ K DIC"
D ^DIR K DIR G:$D(DIRUT) EXIT S ESPX=Y
LKUP S X=ESPX,DIC="^ESP(910.2,",DIC(0)="EZ",DIC("S")="I $P(^(0),U,4)=1&($P(^(0),U,3)=ESPFN)" D ^DIC K DIC S ESPY=+Y I Y'<0 D FND G:'Y NAM S ESPRT(1)=1 D DISPLAY^ESPREG G:$D(DTOUT) EXIT K ESPFN G NAM
I Y<0 W ! G:$D(DUOUT) NUM
W !!,"NO MATCH FOUND."
ADD S DIR(0)="Y",DIR("A")="Do you want to add this decal #",DIR("B")="YES" D ^DIR K DIR I 'Y G NUM
S ESPD(.01)=ESPX
QUES F ESPI=.08,.02,.05,.07,1.01:.01:1.09 Q:$D(DUOUT) S ESPX=ESPI D RD S ESPD(ESPI)=Y
G:$D(DUOUT) NOU
REM W !,"REMARKS: " S DIC="^TMP($J," D EN^DIWE
DISPLAY S I=.01 D W W !,"DECAL COLOR: ",$P(ESPD(.02),U,2)
W !,"FACILITY: ",$P(ESPD(.08),U,2)
S Y=ESPD(.05) D DD^%DT W !,"DATE ASSIGNED: ",Y F I=.07,1.01 D W
W !,"STATE: ",$P(ESPD(1.02),U,2),!,"VEHICLE MAKE: ",$P(ESPD(1.03),U,2) F I=1.04,1.05 D W
W !,"VEHICLE COLOR: ",$P(ESPD(1.06),U,2),! S Y=ESPD(1.07) D DD^%DT W "YEAR OF MANUFACTURE: ",Y,!,"ASSIGNED PARKING SPACE: ",ESPD(1.08),!,"CAR POOL MEMBER: ",$S(ESPD(1.09)="Y":"YES",ESPD(1.09)="N":"NO",1:"")
K ^UTILITY($J,"W") S DIWL=10,DIWR=70,DIWF="W" W !,"REMARKS: " S ESPIEN=0
F I=0:0 S ESPIEN=$O(^TMP($J,ESPIEN)) Q:ESPIEN'>0 S X=^(ESPIEN,0) D ^DIWP
D ^DIWW
OK S DIR(0)="Y",DIR("A")="READY TO UPDATE",DIR("B")="YES" D ^DIR K DIR W !! I 'Y G NOU
STUFF W !,"Updating",!! K DD,DO S DIC="^ESP(910.2,",DIC(0)="L",DLAYGO=910.2,X=ESPD(.01) D FILE^DICN S ESPNUM=+Y
L +^ESP(910.2,ESPNUM):1 I '$T W !,"Another user is editing this record!"
S ^ESP(910.2,ESPNUM,0)=ESPD(.01)_"^"_+ESPD(.02)_"^"_ESPFN_"^1^"_ESPD(.05)_"^^"_ESPD(.07)_"^"_ESPD(.08)
S ^ESP(910.2,ESPNUM,1)=ESPD(1.01)_"^"_$P(ESPD(1.02),U,1)_"^"_$P(ESPD(1.03),U,1)_"^"_ESPD(1.04)_"^"_ESPD(1.05)_"^"_$P(ESPD(1.06),U,1)_"^"_ESPD(1.07)_"^"_ESPD(1.08)_"^"_$P(ESPD(1.09),U)
SREM S %X="^TMP("_$J_",",%Y="^ESP(910.2,"_ESPNUM_",20," D %XY^%RCR K ^TMP($J)
XR S DIK="^ESP(910.2,",DA=ESPNUM D IX1^DIK K DIK,DA W !,"Done",!!
L -^ESP(910.2,ESPNUM)
EXIT W:$D(DTOUT) $C(7)
K DIC,ESPD,ESPFN,ESPI,ESPNUM,Y Q
RD S DIR(0)="910.2,"_ESPX D ^DIR K DA,DIR Q
FND W !,"This decal # is already in the Police Registration Log."
YN1 S DIR(0)="Y",DIR("A")="Do you want to edit this registration",DIR("B")="NO" D ^DIR K DIR W !! Q
NOU W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!",!! K ESPX,ESPD G EN
W W !,$P(^DD(910.2,I,0),U),": ",ESPD(I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPVREG 2805 printed Dec 13, 2024@02:30:59 Page 2
ESPVREG ;DALISC/CKA - VEHICLE REGISTRATION INPUT;3/99
+1 ;;1.0;POLICE & SECURITY;**12,27**;Mar 31, 1994
EN ;
+1 DO DT^DICRW
SET ESPRT(1)=1
FOR I=1:1:13
SET ESPD(I)=""
NAM IF '$DATA(ESPFN)
WRITE !
SET ESPVAR=2
DO EN^ESPMNI
if '$DATA(ESPFN)!($DATA(DTOUT))
GOTO EXIT
SET ESPNAM=$PIECE(^ESP(910,ESPFN,0),U)
NUM WRITE !
SET DIR(0)="FO^1:30"
SET DIR("A")="DECAL"
SET DIR("?")="Enter the Decal # (ex. 9999)"
SET DIR("??")="^S D=""B"",DZ=""??"",DIC=""^ESP(910.2,"",DIC(0)=""AEQZ"",DIC(""S"")=""I $P(^(0),U,4)=1&($P(^(0),U,3)=ESPFN)"" D DQ^DICQ K DIC"
+1 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
SET ESPX=Y
LKUP SET X=ESPX
SET DIC="^ESP(910.2,"
SET DIC(0)="EZ"
SET DIC("S")="I $P(^(0),U,4)=1&($P(^(0),U,3)=ESPFN)"
DO ^DIC
KILL DIC
SET ESPY=+Y
IF Y'<0
DO FND
if 'Y
GOTO NAM
SET ESPRT(1)=1
DO DISPLAY^ESPREG
if $DATA(DTOUT)
GOTO EXIT
KILL ESPFN
GOTO NAM
+1 IF Y<0
WRITE !
if $DATA(DUOUT)
GOTO NUM
+2 WRITE !!,"NO MATCH FOUND."
ADD SET DIR(0)="Y"
SET DIR("A")="Do you want to add this decal #"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF 'Y
GOTO NUM
+1 SET ESPD(.01)=ESPX
QUES FOR ESPI=.08,.02,.05,.07,1.01:.01:1.09
if $DATA(DUOUT)
QUIT
SET ESPX=ESPI
DO RD
SET ESPD(ESPI)=Y
+1 if $DATA(DUOUT)
GOTO NOU
REM WRITE !,"REMARKS: "
SET DIC="^TMP($J,"
DO EN^DIWE
DISPLAY SET I=.01
DO W
WRITE !,"DECAL COLOR: ",$PIECE(ESPD(.02),U,2)
+1 WRITE !,"FACILITY: ",$PIECE(ESPD(.08),U,2)
+2 SET Y=ESPD(.05)
DO DD^%DT
WRITE !,"DATE ASSIGNED: ",Y
FOR I=.07,1.01
DO W
+3 WRITE !,"STATE: ",$PIECE(ESPD(1.02),U,2),!,"VEHICLE MAKE: ",$PIECE(ESPD(1.03),U,2)
FOR I=1.04,1.05
DO W
+4 WRITE !,"VEHICLE COLOR: ",$PIECE(ESPD(1.06),U,2),!
SET Y=ESPD(1.07)
DO DD^%DT
WRITE "YEAR OF MANUFACTURE: ",Y,!,"ASSIGNED PARKING SPACE: ",ESPD(1.08),!,"CAR POOL MEMBER: ",$SELECT(ESPD(1.09)="Y":"YES",ESPD(1.09)="N":"NO",1:"")
+5 KILL ^UTILITY($JOB,"W")
SET DIWL=10
SET DIWR=70
SET DIWF="W"
WRITE !,"REMARKS: "
SET ESPIEN=0
+6 FOR I=0:0
SET ESPIEN=$ORDER(^TMP($JOB,ESPIEN))
if ESPIEN'>0
QUIT
SET X=^(ESPIEN,0)
DO ^DIWP
+7 DO ^DIWW
OK SET DIR(0)="Y"
SET DIR("A")="READY TO UPDATE"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
WRITE !!
IF 'Y
GOTO NOU
STUFF WRITE !,"Updating",!!
KILL DD,DO
SET DIC="^ESP(910.2,"
SET DIC(0)="L"
SET DLAYGO=910.2
SET X=ESPD(.01)
DO FILE^DICN
SET ESPNUM=+Y
+1 LOCK +^ESP(910.2,ESPNUM):1
IF '$TEST
WRITE !,"Another user is editing this record!"
+2 SET ^ESP(910.2,ESPNUM,0)=ESPD(.01)_"^"_+ESPD(.02)_"^"_ESPFN_"^1^"_ESPD(.05)_"^^"_ESPD(.07)_"^"_ESPD(.08)
+3 SET ^ESP(910.2,ESPNUM,1)=ESPD(1.01)_"^"_$PIECE(ESPD(1.02),U,1)_"^"_$PIECE(ESPD(1.03),U,1)_"^"_ESPD(1.04)_"^"_ESPD(1.05)_"^"_$PIECE(ESPD(1.06),U,1)_"^"_ESPD(1.07)_"^"_ESPD(1.08)_"^"_$PIECE(ESPD(1.09),U)
SREM SET %X="^TMP("_$JOB_","
SET %Y="^ESP(910.2,"_ESPNUM_",20,"
DO %XY^%RCR
KILL ^TMP($JOB)
XR SET DIK="^ESP(910.2,"
SET DA=ESPNUM
DO IX1^DIK
KILL DIK,DA
WRITE !,"Done",!!
+1 LOCK -^ESP(910.2,ESPNUM)
EXIT if $DATA(DTOUT)
WRITE $CHAR(7)
+1 KILL DIC,ESPD,ESPFN,ESPI,ESPNUM,Y
QUIT
RD SET DIR(0)="910.2,"_ESPX
DO ^DIR
KILL DA,DIR
QUIT
FND WRITE !,"This decal # is already in the Police Registration Log."
YN1 SET DIR(0)="Y"
SET DIR("A")="Do you want to edit this registration"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
WRITE !!
QUIT
NOU WRITE !!,$CHAR(7),?20,"NO UPDATING HAS OCCURRED!!!",!!
KILL ESPX,ESPD
GOTO EN
W WRITE !,$PIECE(^DD(910.2,I,0),U),": ",ESPD(I)
+1 QUIT
