- PXRMSPED ; SLC/PKR - Edit a reminder sponsor. ;09/02/2005
- ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- ;
- ;==============================================
- 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 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
- ;
- PXRMSPED ; SLC/PKR - Edit a reminder sponsor. ;09/02/2005
- +1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- +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
- 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 ;
