PXRMSPED ;SLC/PKR - Edit a reminder sponsor. ;04/08/2019
;;2.0;CLINICAL REMINDERS;**4,42**;Feb 04, 2005;Build 245
;
;==============================================
N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,NUM,Y
GETNAME ;Get the name of the sponsor to edit.
K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
S DIC="^PXRMD(811.6,"
S DIC(0)="AEMQL"
S DIC("A")="Select Reminder Sponsor: "
S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
S DLAYGO=811.6
;Set the starting place for additions.
D SETSTART^PXRMCOPY(DIC)
W !
D ^DIC
I ($D(DTOUT))!($D(DUOUT)) Q
I Y=-1 G END
S DA=$P(Y,U,1)
S CS1=$$FILE^PXRMEXCS(811.6,DA)
D EDIT(DIC,DA)
;See if any changes have been made, if so do the edit history.
S CS2=$$FILE^PXRMEXCS(811.6,DA)
I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(811.6,DIC,DA)
G GETNAME
END ;
Q
;
;==============================================
EDIT(ROOT,DA) ;
N DIE,DR,DIDEL
S DIE=ROOT,DIDEL=811.6
S DR=".01"
D ^DIE
I $G(DA)="" Q
;
;Class
W !!
S DR="100"
D ^DIE
I $D(Y) Q
;Review date
W !!
S DR="102"
D ^DIE
I $D(Y) Q
;
S DR="1"
D ^DIE
;
S DR="2"
D ^DIE
Q
;
;==============================================
INUSE(SIEN) ;This is used by ^DD(811.6,.01,"DEL",1,0) to determine if it
;is ok to delete a sponsor.
N FILE,FILEA,IEN,IENA,IENT,IND,LIST,NUM,SP
D EN^DDIOL("Checking usage ...")
S NUM=0
;First check for use as an associated sponsor.
S SP=""
F S SP=$O(^PXRMD(811.6,"C",SIEN,SP)) Q:SP="" D
. S NUM=NUM+1
. S FILEA(NUM)=811.6
. S IENA(NUM)=SP
F FILE=801.41,810.9,811.2,811.4,811.5,811.9,9999999.09,9999999.15,9999999.17,9999999.64 D
. K LIST
. D LIST^DIC(FILE,"","@","","","","","","","","LIST")
. S IENT=$P(LIST("DILIST",0),U,1)
. F IND=1:1:IENT D
.. S IEN=LIST("DILIST",2,IND)
.. S SP=+$$GET1^DIQ(FILE,IEN,101,"I")
.. I SP=SIEN D
... S NUM=NUM+1
... S FILEA(NUM)=FILE
... S IENA(NUM)=IEN
I NUM>0 D
. D EN^DDIOL("This Sponsor cannot be deleted, it is in use by the following:")
. D EN^DDIOL("FILE","","!!")
. D EN^DDIOL("ENTRY","","?35")
. D EN^DDIOL("----")
. D EN^DDIOL("-----","","?35")
. F IND=1:1:NUM D
.. S IENA(IND)=$$GET1^DIQ(FILEA(IND),IENA(IND),.01)
.. S FILEA(IND)=$$GET1^DID(FILEA(IND),"","","NAME")
.. D EN^DDIOL(FILEA(IND))
.. D EN^DDIOL(IENA(IND),"","?35")
. D EN^DDIOL("","","!!")
Q NUM
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSPED 2348 printed Nov 22, 2024@16:59:24 Page 2
PXRMSPED ;SLC/PKR - Edit a reminder sponsor. ;04/08/2019
+1 ;;2.0;CLINICAL REMINDERS;**4,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;==============================================
+4 NEW CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,NUM,Y
GETNAME ;Get the name of the sponsor to edit.
+1 KILL DA,DIC,DLAYGO,DTOUT,DUOUT,Y
+2 SET DIC="^PXRMD(811.6,"
+3 SET DIC(0)="AEMQL"
+4 SET DIC("A")="Select Reminder Sponsor: "
+5 SET DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
+6 SET DLAYGO=811.6
+7 ;Set the starting place for additions.
+8 DO SETSTART^PXRMCOPY(DIC)
+9 WRITE !
+10 DO ^DIC
+11 IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+12 IF Y=-1
GOTO END
+13 SET DA=$PIECE(Y,U,1)
+14 SET CS1=$$FILE^PXRMEXCS(811.6,DA)
+15 DO EDIT(DIC,DA)
+16 ;See if any changes have been made, if so do the edit history.
+17 SET CS2=$$FILE^PXRMEXCS(811.6,DA)
+18 IF CS2'=0
IF CS2'=CS1
DO SEHIST^PXRMUTIL(811.6,DIC,DA)
+19 GOTO GETNAME
END ;
+1 QUIT
+2 ;
+3 ;==============================================
EDIT(ROOT,DA) ;
+1 NEW DIE,DR,DIDEL
+2 SET DIE=ROOT
SET DIDEL=811.6
+3 SET DR=".01"
+4 DO ^DIE
+5 IF $GET(DA)=""
QUIT
+6 ;
+7 ;Class
+8 WRITE !!
+9 SET DR="100"
+10 DO ^DIE
+11 IF $DATA(Y)
QUIT
+12 ;Review date
+13 WRITE !!
+14 SET DR="102"
+15 DO ^DIE
+16 IF $DATA(Y)
QUIT
+17 ;
+18 SET DR="1"
+19 DO ^DIE
+20 ;
+21 SET DR="2"
+22 DO ^DIE
+23 QUIT
+24 ;
+25 ;==============================================
INUSE(SIEN) ;This is used by ^DD(811.6,.01,"DEL",1,0) to determine if it
+1 ;is ok to delete a sponsor.
+2 NEW FILE,FILEA,IEN,IENA,IENT,IND,LIST,NUM,SP
+3 DO EN^DDIOL("Checking usage ...")
+4 SET NUM=0
+5 ;First check for use as an associated sponsor.
+6 SET SP=""
+7 FOR
SET SP=$ORDER(^PXRMD(811.6,"C",SIEN,SP))
if SP=""
QUIT
Begin DoDot:1
+8 SET NUM=NUM+1
+9 SET FILEA(NUM)=811.6
+10 SET IENA(NUM)=SP
End DoDot:1
+11 FOR FILE=801.41,810.9,811.2,811.4,811.5,811.9,9999999.09,9999999.15,9999999.17,9999999.64
Begin DoDot:1
+12 KILL LIST
+13 DO LIST^DIC(FILE,"","@","","","","","","","","LIST")
+14 SET IENT=$PIECE(LIST("DILIST",0),U,1)
+15 FOR IND=1:1:IENT
Begin DoDot:2
+16 SET IEN=LIST("DILIST",2,IND)
+17 SET SP=+$$GET1^DIQ(FILE,IEN,101,"I")
+18 IF SP=SIEN
Begin DoDot:3
+19 SET NUM=NUM+1
+20 SET FILEA(NUM)=FILE
+21 SET IENA(NUM)=IEN
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF NUM>0
Begin DoDot:1
+23 DO EN^DDIOL("This Sponsor cannot be deleted, it is in use by the following:")
+24 DO EN^DDIOL("FILE","","!!")
+25 DO EN^DDIOL("ENTRY","","?35")
+26 DO EN^DDIOL("----")
+27 DO EN^DDIOL("-----","","?35")
+28 FOR IND=1:1:NUM
Begin DoDot:2
+29 SET IENA(IND)=$$GET1^DIQ(FILEA(IND),IENA(IND),.01)
+30 SET FILEA(IND)=$$GET1^DID(FILEA(IND),"","","NAME")
+31 DO EN^DDIOL(FILEA(IND))
+32 DO EN^DDIOL(IENA(IND),"","?35")
End DoDot:2
+33 DO EN^DDIOL("","","!!")
End DoDot:1
+34 QUIT NUM
+35 ;
