source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLI.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PXRMEXLI ; SLC/PKR - List Manager routines for repository entry install. ;08/08/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;================================================
5INSALL ;Install all components in a repository entry.
6 N IND,INSTALL
7 ;Initialize the name change storage.
8 K PXRMNMCH
9 S (IND,INSTALL,PXRMDONE)=0
10 F S IND=$O(^TMP("PXRMEXLC",$J,"SEL",IND)) Q:(+IND=0)!(PXRMDONE) D
11 . D INSCOM(IND,.INSTALL)
12 ;
13 ;If anything was installed rebuild the display.
14 I INSTALL D CDISP^PXRMEXLC(PXRMRIEN)
15 ;
16 ;Save the install history in the repository.
17 D SAVHIST^PXRMEXU1
18 Q
19 ;
20 ;================================================
21INSCOM(IND,INSTALL) ;Install component IND.
22 ;PXRMRIEN is not passed because this is invoked by the ListManger
23 ;action to install a repository entry.
24 N ACTION,ATTR,END,EXISTS,FIELDNUM,FILENUM,IND120,JND120
25 N NEWNAME,NEWPT01,PT01,RTN,START,TEMP,TEMP0
26 S TEMP=^TMP("PXRMEXLC",$J,"SEL",IND)
27 S FILENUM=$P(TEMP,U,1)
28 S EXISTS=$P(TEMP,U,4)
29 ;Dialogs use their own installation screen.
30 I FILENUM=801.41 D Q
31 . D START^PXRMEXLD
32 . S VALMBCK="R"
33 S IND120=$P(TEMP,U,2)
34 S JND120=$P(TEMP,U,3)
35 S TEMP=^PXD(811.8,PXRMRIEN,120,IND120,1,JND120,0)
36 S START=$P(TEMP,U,2)
37 S END=$P(TEMP,U,3)
38 S TEMP=^PXD(811.8,PXRMRIEN,100,START,0)
39 ;Go to full screen mode.
40 D FULL^VALM1
41 I ((FILENUM=0)!(FILENUM=811.4)),DUZ(0)'="@" D Q
42 . I FILENUM=0 W !,"Only programmers can install routines."
43 . I FILENUM=811.4 W !,"Only programmers can install Reminder Computed Findings."
44 . H 2
45 . S VALMBCK="R"
46 I FILENUM=0 D
47 . D RTNLD^PXRMEXIC(PXRMRIEN,START,END,.ATTR,.RTN)
48 . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
49 . S ACTION=$$GETRACT^PXRMEXCF(.ATTR,.NEWNAME,.PXRMNMCH,.RTN,EXISTS)
50 .;Save what was done for the installation summary.
51 . S ^TMP("PXRMEXIA",$J,IND,"ROUTINE",ATTR("NAME"),ACTION)=NEWNAME
52 E D
53 .;Make sure we have the .01, some files have .001.
54 . S TEMP0=$P(TEMP,";",3)
55 . S FIELDNUM=$P(TEMP0,"~",1)
56 . I FIELDNUM=.001 S TEMP=^PXD(811.8,PXRMRIEN,100,(START+1),0)
57 . S PT01=$P(TEMP,"~",2)
58 . D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
59 . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
60 . S ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXISTS)
61 .;Save what was done for the installation summary.
62 . S ^TMP("PXRMEXIA",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
63 ;If the ACTION is Quit then quit the entire install.
64 I ACTION="Q" S PXRMDONE=1 Q
65 ;If the ACTION is Skip then skip this component.
66 I ACTION="S" S VALMBCK="R" Q
67 ;If the ACTION is rePlace then skip this component.
68 I ACTION="P" S VALMBCK="R" Q
69 ;Install this component.
70 I FILENUM=0 D
71 . S NEWPT01=$G(PXRMNMCH(ATTR("FILE NUMBER"),ATTR("NAME")))
72 . I NEWPT01="" S NEWPT01=ATTR("NAME")
73 . D RTNSAVE^PXRMEXIC(.RTN,NEWPT01)
74 . S INSTALL=1
75 E D
76 . D FILE^PXRMEXIC(PXRMRIEN,EXISTS,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
77 . S INSTALL=1
78 S VALMBCK="R"
79 Q
80 ;
81 ;================================================
82INSSEL ;Get a list of components to install.
83 N IND,INSTALL,VALMBG,VALMLST,VALMY
84 ;
85 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXLC",$J,"IDX",""),-1)
86 ;
87 ;Get the list to install.
88 D EN^VALM2(XQORNOD(0))
89 ;If there is no list quit.
90 I '$D(VALMY) Q
91 ;
92 ;Initialize the name change storage.
93 K PXRMNMCH
94 S (IND,INSTALL)=0
95 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D INSCOM(IND,.INSTALL)
96 ;
97 ;If anything was installed rebuild the display.
98 I INSTALL D CDISP^PXRMEXLC(PXRMRIEN)
99 ;
100 ;Save the install history in the repository.
101 D SAVHIST^PXRMEXU1
102 Q
103 ;
104 ;================================================
105INSTALL ;Install the repository entry PXRMRIEN.
106 N IEN,IND,VALMY
107 ;Make sure the component list exists for this entry. PXRMRIEN is
108 ;set in INSTALL^PXRMEXLR.
109 I '$D(^PXD(811.8,PXRMRIEN,120)) D CLIST^PXRMEXU1(.PXRMRIEN)
110 I PXRMRIEN=-1 Q
111 K ^TMP("PXRMEXIA",$J),^TMP("PXRMEXIAD",$J)
112 ;Set the install date and time and type.
113 S ^TMP("PXRMEXIA",$J,"DT")=$$NOW^XLFDT
114 S ^TMP("PXRMEXIA",$J,"TYPE")="INTERACTIVE"
115 ;Format the component list for display.
116 D CDISP^PXRMEXLC(PXRMRIEN)
117 S VALMCNT=$O(^TMP("PXRMEXLC",$J,"IDX"),-1)
118 S VALMBCK="R"
119 D XQORM
120 Q
121 ;
122 ;================================================
123 ;Exit action added to PXRM EXCH INSTALL MENU
124PEXIT ;PXRM EXCH INSTALL MENU protocol exit code
125 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
126 ;Reset after page up/down etc
127 D XQORM
128 Q
129 ;
130 ;================================================
131XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT COMPONENT",0))_U_"1:"_VALMCNT
132 S XQORM("A")="Select Action: "
133 Q
134 ;
135 ;================================================
136XSEL ;PXRM EXCH SELECT COMPONENT validation
137 N CNT,SELECT,SEL,PXRMDONE
138 S SELECT=$P(XQORNOD(0),"=",2)
139 I '$$VALID^PXRMEXLD(SELECT) S VALMBCK="R" Q
140 ;
141 ;Sort selections into ascending sequence order
142 D ORDER^PXRMEXLC(.SELECT,1)
143 ;
144 K ^TMP("PXRMEXIA",$J),^TMP("PXRMEXIAD",$J)
145 ;Set the install date and time and type.
146 S ^TMP("PXRMEXIA",$J,"DT")=$$NOW^XLFDT
147 S ^TMP("PXRMEXIA",$J,"TYPE")="INTERACTIVE"
148 ;
149 ;Install selected component
150 N INSTALL
151 S INSTALL=0,CNT=0,PXRMDONE=0
152 F CNT=1:1 S SEL=$P(SELECT,",",CNT) Q:'SEL D Q:PXRMDONE
153 . D INSCOM(SEL,.INSTALL)
154 ;
155 ;If anything was installed rebuild the display.
156 I INSTALL D CDISP^PXRMEXLC(PXRMRIEN)
157 ;
158 ;Save the install history in the repository.
159 D SAVHIST^PXRMEXU1
160 ;
161 ;Clear any renames made in the last session
162 K PXRMNMCH
163 Q
Note: See TracBrowser for help on using the repository browser.