- 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 Feb 18, 2025@23:57:30 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
