ESPREGWP ;;ALB/CJM-ESP POLICE REGISTRATION ;1/19/1997
;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
;
REGISTER(REGTYPE) ;
;selects or creates a registration, then edits it
N NAME,NEW,DIC,DIE,DA,DR,DLAYGO
Q:(($G(REGTYPE)'=2)&($G(REGTYPE)'=3)&($G(REGTYPE)'=4)&($G(REGTYPE)'=5))
;
S DIC=910.2,DIC(0)="AELMQ",DLAYGO=910.2
S DIC("S")="I $P(^(0),U,4)="_REGTYPE
D ^DIC
S REG=+Y,NEW=$P(Y,"^",3)
I REG D EDITREG(REG,REGTYPE,NEW)
Q
;
EDITREG(REG,REGTYPE,NEW) ;
N DIE,DA,DR,DLAYGO,DIC
S DIE=910.2,DA=REG,DR="[ESP REGISTRATION "_REGTYPE_"]",DLAYGO=910.2
D ^DIE
I $D(Y) D
.I NEW D DELETE(REG)
E D
.S NAME=$$GETNAME
.I NAME S DR=".03////^S X=NAME" D ^DIE
Q
;
GETNAME() ;
;allows selection from Master Name Index file or creation of new name
;returns ien, or 0 if none selected
;
N DIC,D,DINUM,DR,X,DLAYGO,DIR,Y,QUIT,NEW,NAME
S (QUIT,NEW,NAME)=0
F Q:QUIT D
.W !!,"Who should it be registered to?",!!
.S DIC="^ESP(910,",DIC(0)="AELMQ",DLAYGO=910,DIC("A")="Enter Registrant: "
.D ^DIC
.S NAME=$S(+Y<0:0,1:+Y)
.I 'NAME S QUIT=1 Q
.S NEW=$P(Y,"^",3)
.I NEW S QUIT=1 Q
.I 'NEW D
..N DIR
..S DIR(0)="Y"
..S DIR("A")="You wish to select "_$P(Y,"^",2)_" as the registrant"
..S DIR("B")="YES"
..D ^DIR
..I Y S QUIT=1
..E S NAME=0 W !,"Another person with the same name can be entered by using quotes!"
D:NAME EDITNAME(NAME)
Q NAME
;
EDITNAME(NAME) ;
;allows user to edit entry in the Master Name Index file
;INPUT -
; NAME - ien in Master Name Index file
;
N DIE,DA,DR,DLAYGO,DIC
S DIE=910,DA=NAME,DR="[ESP REGISTRATION]",DLAYGO=910
D ^DIE
Q
;
DELETE(NAME) ;
N DIK,DA
S DIK="^ESP(910.2,",DA=NAME
D ^DIK
W !,"** TAG DELETED FROM POLICE REGISTRATION LOG **"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPREGWP 1765 printed Dec 13, 2024@02:30:17 Page 2
ESPREGWP ;;ALB/CJM-ESP POLICE REGISTRATION ;1/19/1997
+1 ;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
+2 ;
REGISTER(REGTYPE) ;
+1 ;selects or creates a registration, then edits it
+2 NEW NAME,NEW,DIC,DIE,DA,DR,DLAYGO
+3 if (($GET(REGTYPE)'=2)&($GET(REGTYPE)'=3)&($GET(REGTYPE)'=4)&($GET(REGTYPE)'=5))
QUIT
+4 ;
+5 SET DIC=910.2
SET DIC(0)="AELMQ"
SET DLAYGO=910.2
+6 SET DIC("S")="I $P(^(0),U,4)="_REGTYPE
+7 DO ^DIC
+8 SET REG=+Y
SET NEW=$PIECE(Y,"^",3)
+9 IF REG
DO EDITREG(REG,REGTYPE,NEW)
+10 QUIT
+11 ;
EDITREG(REG,REGTYPE,NEW) ;
+1 NEW DIE,DA,DR,DLAYGO,DIC
+2 SET DIE=910.2
SET DA=REG
SET DR="[ESP REGISTRATION "_REGTYPE_"]"
SET DLAYGO=910.2
+3 DO ^DIE
+4 IF $DATA(Y)
Begin DoDot:1
+5 IF NEW
DO DELETE(REG)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET NAME=$$GETNAME
+8 IF NAME
SET DR=".03////^S X=NAME"
DO ^DIE
End DoDot:1
+9 QUIT
+10 ;
GETNAME() ;
+1 ;allows selection from Master Name Index file or creation of new name
+2 ;returns ien, or 0 if none selected
+3 ;
+4 NEW DIC,D,DINUM,DR,X,DLAYGO,DIR,Y,QUIT,NEW,NAME
+5 SET (QUIT,NEW,NAME)=0
+6 FOR
if QUIT
QUIT
Begin DoDot:1
+7 WRITE !!,"Who should it be registered to?",!!
+8 SET DIC="^ESP(910,"
SET DIC(0)="AELMQ"
SET DLAYGO=910
SET DIC("A")="Enter Registrant: "
+9 DO ^DIC
+10 SET NAME=$SELECT(+Y<0:0,1:+Y)
+11 IF 'NAME
SET QUIT=1
QUIT
+12 SET NEW=$PIECE(Y,"^",3)
+13 IF NEW
SET QUIT=1
QUIT
+14 IF 'NEW
Begin DoDot:2
+15 NEW DIR
+16 SET DIR(0)="Y"
+17 SET DIR("A")="You wish to select "_$PIECE(Y,"^",2)_" as the registrant"
+18 SET DIR("B")="YES"
+19 DO ^DIR
+20 IF Y
SET QUIT=1
+21 IF '$TEST
SET NAME=0
WRITE !,"Another person with the same name can be entered by using quotes!"
End DoDot:2
End DoDot:1
+22 if NAME
DO EDITNAME(NAME)
+23 QUIT NAME
+24 ;
EDITNAME(NAME) ;
+1 ;allows user to edit entry in the Master Name Index file
+2 ;INPUT -
+3 ; NAME - ien in Master Name Index file
+4 ;
+5 NEW DIE,DA,DR,DLAYGO,DIC
+6 SET DIE=910
SET DA=NAME
SET DR="[ESP REGISTRATION]"
SET DLAYGO=910
+7 DO ^DIE
+8 QUIT
+9 ;
DELETE(NAME) ;
+1 NEW DIK,DA
+2 SET DIK="^ESP(910.2,"
SET DA=NAME
+3 DO ^DIK
+4 WRITE !,"** TAG DELETED FROM POLICE REGISTRATION LOG **"
+5 QUIT
