source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSPED.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PXRMSPED ; SLC/PKR - Edit a reminder sponsor. ;09/02/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;==============================================
5 N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,NUM,Y
6GETNAME ;Get the name of the sponsor to edit.
7 K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
8 S DIC="^PXRMD(811.6,"
9 S DIC(0)="AEMQL"
10 S DIC("A")="Select Reminder Sponsor: "
11 S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
12 S DLAYGO=811.6
13 ;Set the starting place for additions.
14 D SETSTART^PXRMCOPY(DIC)
15 W !
16 D ^DIC
17 I ($D(DTOUT))!($D(DUOUT)) Q
18 I Y=-1 G END
19 S DA=$P(Y,U,1)
20 S CS1=$$FILE^PXRMEXCS(811.6,DA)
21 D EDIT(DIC,DA)
22 ;See if any changes have been made, if so do the edit history.
23 S CS2=$$FILE^PXRMEXCS(811.6,DA)
24 I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(811.6,DIC,DA)
25 G GETNAME
26END ;
27 Q
28 ;
29 ;==============================================
30EDIT(ROOT,DA) ;
31 N DIE,DR,DIDEL
32 S DIE=ROOT,DIDEL=811.6
33 S DR=".01"
34 D ^DIE
35 I $G(DA)="" Q
36 ;
37 ;Class
38 W !!
39 S DR="100"
40 D ^DIE
41 I $D(Y) Q
42 ;Review date
43 W !!
44 S DR="102"
45 D ^DIE
46 I $D(Y) Q
47 ;
48 S DR="1"
49 D ^DIE
50 ;
51 S DR="2"
52 D ^DIE
53 Q
54 ;
55 ;==============================================
56INUSE(SIEN) ;This is used by ^DD(811.6,.01,"DEL",1,0) to determine if it
57 ;is ok to delete a sponsor.
58 N FILE,FILEA,IEN,IENA,IENT,IND,LIST,NUM,SP
59 D EN^DDIOL("Checking usage ...")
60 S NUM=0
61 ;First check for use as an associated sponsor.
62 S SP=""
63 F S SP=$O(^PXRMD(811.6,"C",SIEN,SP)) Q:SP="" D
64 . S NUM=NUM+1
65 . S FILEA(NUM)=811.6
66 . S IENA(NUM)=SP
67 F FILE=801.41,810.9,811.2,811.4,811.5,811.9 D
68 . K LIST
69 . D LIST^DIC(FILE,"","@","","","","","","","","LIST")
70 . S IENT=$P(LIST("DILIST",0),U,1)
71 . F IND=1:1:IENT D
72 .. S IEN=LIST("DILIST",2,IND)
73 .. S SP=+$$GET1^DIQ(FILE,IEN,101,"I")
74 .. I SP=SIEN D
75 ... S NUM=NUM+1
76 ... S FILEA(NUM)=FILE
77 ... S IENA(NUM)=IEN
78 I NUM>0 D
79 . D EN^DDIOL("This Sponsor cannot be deleted, it is in use by the following:")
80 . D EN^DDIOL("FILE","","!!")
81 . D EN^DDIOL("ENTRY","","?35")
82 . D EN^DDIOL("----")
83 . D EN^DDIOL("-----","","?35")
84 . F IND=1:1:NUM D
85 .. S IENA(IND)=$$GET1^DIQ(FILEA(IND),IENA(IND),.01)
86 .. S FILEA(IND)=$$GET1^DID(FILEA(IND),"","","NAME")
87 .. D EN^DDIOL(FILEA(IND))
88 .. D EN^DDIOL(IENA(IND),"","?35")
89 . D EN^DDIOL("","","!!")
90 Q NUM
91 ;
Note: See TracBrowser for help on using the repository browser.