source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP5I.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PXRMP5I ; SLC/AGP - Patch 5 init routine. ;09/16/2005
2 ;;2.0;CLINICAL REMINDERS;**5**;Feb 04, 2005
3 ;Reminder Exchange install.
4 Q
5 ;
6 ;===============================================================
7ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
8 ;
9 S ARRAY(1,1)="VA-IRAQ & AFGHAN POST-DEPLOY SCREEN"
10 I MODE S ARRAY(1,2)="09/20/2005@10:35:40"
11 Q
12 ;
13 ;===============================================================
14DELDD ;Delete the old data dictionaries.
15 N DIU,TEXT
16 D EN^DDIOL("Removing old data dictionaries.")
17 S DIU(0)=""
18 S DIU=811.6
19 S TEXT=" Deleting data dictionary for file # "_DIU
20 D EN^DDIOL(TEXT)
21 D EN^DIU2
22 Q
23 ;===============================================================
24DELEI ;If the Exchange File entry already exists delete it.
25 N ARRAY,IC,IND,LIST,LUVALUE,NUM
26 D ARRAY(1,.ARRAY)
27 S IC=0
28 F S IC=$O(ARRAY(IC)) Q:'IC D
29 .S LUVALUE(1)=ARRAY(IC,1)
30 .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
31 .I '$D(LIST) Q
32 .S NUM=$P(LIST("DILIST",0),U,1)
33 .I NUM'=0 D
34 ..F IND=1:1:NUM D
35 ... N DA,DIK
36 ... S DIK="^PXD(811.8,"
37 ... S DA=LIST("DILIST",2,IND)
38 ... D ^DIK
39 Q
40 ;
41 ;===============================================================
42EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to
43 ;include in the build. This is used in the build to determine which
44 ;entries to include.
45 N ARRAY,FOUND,IEN,IC,LUVALUE
46 D ARRAY(1,.ARRAY)
47 S FOUND=0
48 S IC=0
49 F S IC=+$O(ARRAY(IC)) Q:(IC=0)!(FOUND) D
50 . M LUVALUE=ARRAY(IC)
51 . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
52 . I IEN=Y S FOUND=1 Q
53 Q FOUND
54 ;
55PRE ;
56 D SSPC
57 D DELDD
58 D DELEI
59 Q
60POST ;
61 D RSPC
62 D SMEXINS
63 Q
64 ;===============================================================
65RSPC ;Restore the sponser classes to the new location.
66 N ARRAY,CLASS,IEN,NAME,TEMP
67 S ARRAY("INFECTIOUS DISEASES PROGRAM OFFICE, VAHQ")="N"
68 S ARRAY("JOHN D DEMAKIS")="N"
69 S ARRAY("Mental Health and Behavioral Science Strategic Group")="N"
70 S ARRAY("Mental Health and Behavioral Science Strategic Group and Women Veterans Health Program")="N"
71 S ARRAY("National Clinical Practice Guideline Council")="N"
72 S ARRAY("Office of Geriatric Extended Care")="N"
73 S ARRAY("Office of Public Health and Environmental Hazards")="N"
74 S ARRAY("Office of Quality & Performance")="N"
75 S ARRAY("Women Veterans Health Program")="N"
76 D BMES^XPDUTL("Restoring Sponsor Classes")
77 S IEN=0
78 F S IEN=+$O(^XTMP("PXRMSPCS",IEN)) Q:IEN=0 D
79 . S CLASS=^XTMP("PXRMSPCS",IEN)
80 . S $P(^PXRMD(811.6,IEN,100),U,1)=CLASS
81 S IEN=0
82 F S IEN=$O(^PXRMD(811.6,IEN)) Q:IEN'>0 D
83 . S CLASS=$P($G(^PXRMD(811.6,IEN,100)),U)
84 . I CLASS="" D
85 . .S TEMP=$P($G(^PXRMD(811.6,IEN,0)),U,2)
86 . .S NAME=$P($G(^PXRMD(811.6,IEN,0)),U) Q:NAME=""
87 . .I TEMP="" S TEMP=$S($D(ARRAY(NAME))>0:ARRAY(NAME),1:"L")
88 . .S $P(^PXRMD(811.6,IEN,100),U)=TEMP,CLASS=TEMP
89 . I CLASS'="" D
90 . .S TEMP=^PXRMD(811.6,IEN,0)
91 . .S ^PXRMD(811.6,IEN,0)=$P(TEMP,U)
92 Q
93 ;===============================================================
94SMEXINS ;Silent mode install.
95 N ARRAY,IC,IEN,LUVALUE,PXRMINST
96 S PXRMINST=1
97 D ARRAY(1,.ARRAY)
98 S IC=0
99 F S IC=$O(ARRAY(IC)) Q:'IC D
100 .M LUVALUE=ARRAY(IC)
101 .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
102 .I IEN'=0 D
103 .. N TEXT
104 .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
105 .. E S TEXT="Installing reminder "_LUVALUE(1)
106 .. D BMES^XPDUTL(TEXT)
107 .. D INSTALL^PXRMEXSI(IEN,1)
108 Q
109 ;
110 ;===============================================================
111SSPC ;Save the Sponsor classes.
112 N CDATE,CLASS,IEN,PDATE
113 D BMES^XPDUTL("Saving Sponsor Classes")
114 S CDATE=$$NOW^XLFDT
115 S PDATE=$$FMADD^XLFDT(CDATE,30)
116 S ^XTMP("PXRMSPCS",0)=PDATE_U_CDATE_U_"SPONSOR CLASSES"
117 S IEN=0
118 F S IEN=+$O(^PXRMD(811.6,IEN)) Q:IEN=0 D
119 . S CLASS=$P($G(^PXRMD(811.6,IEN,0)),U,2)
120 . ;CHECK FOR TEST SITES
121 . I $G(CLASS)="" S CLASS=$P($G(^PXRMD(811.6,IEN,100)),U)
122 . S ^XTMP("PXRMSPCS",IEN)=CLASS
123 Q
Note: See TracBrowser for help on using the repository browser.