source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXIH.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1PXRMEXIH ; SLC/PKR - Routines for installation history. ;08/08/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;======================================================
4BLDLIST ;Build a list of install histories in ^TMP("PXRMEXIH",$J).
5 N DATE,FMTSTR,IHIEN,IND,INDONE,JND,NAME,NL,NLINE,NSEL,OUTPUT
6 N SOURCE,TDATE,TEMP,TEXT,TYPE
7 K ^TMP("PXRMEXIH",$J)
8 S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"LLL")
9 S (NLINE,NSEL,VALMCNT)=0
10 S INDONE=+$P($G(^PXD(811.8,PXRMRIEN,130,0)),U,4)
11 S TEMP=^PXD(811.8,PXRMRIEN,0)
12 S NAME=" "_$P(TEMP,U,1)
13 S SOURCE=$P(TEMP,U,2)
14 S DATE=$P(TEMP,U,3)
15 D FMT(NAME,SOURCE,DATE,FMTSTR,.NL,.OUTPUT)
16 F JND=1:1:NL S NLINE=NLINE+1,^TMP("PXRMEXIH",$J,NLINE,0)=OUTPUT(JND)
17 S FMTSTR="4R1^20L2^15L2^35L"
18 S TEXT=" ^Installation Date^Type^Installed By"
19 D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
20 F JND=1:1:NL S NLINE=NLINE+1,^TMP("PXRMEXIH",$J,NLINE,0)=OUTPUT(JND)
21 S TEXT=" ^-------------------^----^------------"
22 D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
23 F JND=1:1:NL S NLINE=NLINE+1,^TMP("PXRMEXIH",$J,NLINE,0)=OUTPUT(JND)
24 I 'INDONE D Q
25 . S NLINE=NLINE+1
26 . S ^TMP("PXRMEXIH",$J,NLINE,0)=" none"
27 . S NLINE=NLINE+1
28 . S ^TMP("PXRMEXIH",$J,NLINE,0)=" "
29 ;Build the "dummy" lines so EN^VALM2 will work.
30 F IND=1:1:NLINE S ^TMP("PXRMEXIH",$J,"IDX",IND,1)=""
31 S DATE=""
32 F S DATE=$O(^PXD(811.8,PXRMRIEN,130,"B",DATE)) Q:DATE="" D
33 . S NSEL=NSEL+1
34 . S IHIEN=$O(^PXD(811.8,PXRMRIEN,130,"B",DATE,""))
35 . S TEMP=^PXD(811.8,PXRMRIEN,130,IHIEN,0)
36 . S TDATE=$$FMTE^XLFDT($P(TEMP,U,1),"5Z")
37 . S SOURCE=$P(TEMP,U,2)
38 . S TYPE=$P(TEMP,U,3)
39 . S TEXT=NSEL_U_TDATE_U_TYPE_U_SOURCE
40 . D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
41 . F JND=1:1:NL D
42 .. S NLINE=NLINE+1,^TMP("PXRMEXIH",$J,NLINE,0)=OUTPUT(JND)
43 .. S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
44 .. S ^TMP("PXRMEXIH",$J,"SEL",NSEL)=PXRMRIEN_U_IHIEN
45 S NLINE=NLINE+1,^TMP("PXRMEXIH",$J,NLINE,0)=" "
46 S VALMCNT=NLINE
47 S ^TMP("PXRMEXIH",$J,"VALMCNT")=NLINE
48 S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
49 Q
50 ;
51 ;======================================================
52DELETE(LIST) ;Delete the install histories on the list.
53 N IHIEN,IND,RIEN,TEMP
54 S IND=""
55 F S IND=$O(LIST(IND)) Q:IND="" D
56 . S TEMP=^TMP("PXRMEXIH",$J,"SEL",IND)
57 . S RIEN=$P(TEMP,U,1)
58 . S IHIEN=$P(TEMP,U,2)
59 . D DELHIST^PXRMEXU1(RIEN,IHIEN)
60 ;Rebuild the history list display.
61 D BLDLIST
62 S VALMBCK="R"
63 Q
64 ;
65 ;======================================================
66DELHIST ;Get a list of repository installation entries and delete them.
67 ;Save the original list, it contains the selected repository entries.
68 N VALMBG,VALMLST,VALMY
69 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXIH",$J,"IDX",""),-1)
70 ;Get the list to delete.
71 D EN^VALM2(XQORNOD(0))
72 ;If there is no list quit.
73 I '$D(VALMY) Q
74 D DELETE(.VALMY)
75 Q
76 ;
77 ;======================================================
78DETAILS ;Output the details of an installation.
79 N VALMBG,VALMCNT,VALMLST,VALMY
80 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXIH",$J,"IDX",""),-1)
81 S VALMCNT=^TMP("PXRMEXIH",$J,"VALMCNT")
82 ;Get the list to display.
83 D EN^VALM2(XQORNOD(0))
84 ;If there is no list quit.
85 I '$D(VALMY) Q
86 D DDISP(.VALMY)
87 Q
88 ;
89 ;==================================================
90DDISP(ARRAY) ;Display details list
91 N ACTION,CAPTION,CMPNT,DI,DP,ENTRY,FMTSTR,IHIEN,IND,JND,KND
92 N NL,NLINE,OUTPUT,RIEN,TEMP,TEXT,VALMCNT,VALMHDR
93 K ^TMP("PXRMEXID",$J)
94 ;If there are no items then quit.
95 I '$D(ARRAY) Q
96 S FMTSTR="4R1^34L2^6C2^34L"
97 S VALMCNT=0
98 S TEMP=^PXD(811.8,PXRMRIEN,0)
99 S ENTRY=$E($P(TEMP,U,1),1,38)
100 S DP=$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
101 ;CAPTION is used in ENTRY action of LM template
102 S CAPTION="Entry: "_ENTRY_" Date Packed: "_DP
103 S (IND,NLINE,NUM)=0
104 F S IND=$O(ARRAY(IND)) Q:IND="" D
105 . S TEMP=^TMP("PXRMEXIH",$J,"SEL",IND)
106 . S RIEN=$P(TEMP,U,1)
107 . S IHIEN=$P(TEMP,U,2)
108 . S DI=$$FMTE^XLFDT(^PXD(811.8,RIEN,130,IHIEN,0),"5Z")
109 . I NLINE>1 D
110 .. S NLINE=NLINE+1
111 .. S ^TMP("PXRMEXID",$J,NLINE,0)="------------------------------------------------------------------------------"
112 . S NLINE=NLINE+1
113 . S ^TMP("PXRMEXID",$J,NLINE,0)="Installation date: "_DI
114 .;Write the header line here.
115 . S NLINE=NLINE+1
116 . S ^TMP("PXRMEXID",$J,NLINE,0)=" Component Action New Name"
117 . S CMPNT=""
118 . S JND=0
119 . F S JND=$O(^PXD(811.8,RIEN,130,IHIEN,1,JND)) Q:JND="" D
120 .. S TEMP=^PXD(811.8,RIEN,130,IHIEN,1,JND,0)
121 .. I $P(TEMP,U,2)'=CMPNT D
122 ... S NLINE=NLINE+1
123 ... S ^TMP("PXRMEXID",$J,NLINE,0)=" "
124 ... S CMPNT=$P(TEMP,U,2)
125 ... S NLINE=NLINE+1
126 ... S ^TMP("PXRMEXID",$J,NLINE,0)=CMPNT
127 ..;The first piece is the component number in the packed reminder.
128 .. S TEXT=$P(TEMP,U,1)_U_$P(TEMP,U,3,5)
129 .. D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
130 .. F KND=1:1:NL S NLINE=NLINE+1,^TMP("PXRMEXID",$J,NLINE,0)=OUTPUT(KND)
131 ..;If there are Additional Details add them to the display.
132 .. S KND=0
133 .. F S KND=$O(^PXD(811.8,RIEN,130,IHIEN,1,JND,1,KND)) Q:KND="" D
134 ... S NLINE=NLINE+1
135 ... S ^TMP("PXRMEXID",$J,NLINE,0)=^PXD(811.8,RIEN,130,IHIEN,1,JND,1,KND,0)
136 . S NLINE=NLINE+1
137 . S ^TMP("PXRMEXID",$J,NLINE,0)=" "
138 S VALMHDR(1)=^PXD(811.8,RIEN,0)_" "_^TMP("PXRMEXID",$J,1,0)
139 S VALMCNT=NLINE
140 D EN^VALM("PXRM EX INSTALLATION DETAIL")
141 K ^TMP("PXRMEXID",$J)
142 Q
143 ;
144 ;======================================================
145ENTRY ;List Manager ENTRY entry point.
146 D BLDLIST,XQORM
147 Q
148 ;
149 ;======================================================
150EXIT ;List Manager EXIT entry point.
151 K ^TMP("PXRMEXIH",$J)
152 Q
153 ;
154 ;======================================================
155FMT(ENTRY,SOURCE,DATE,FMTSTR,NL,OUTPUT) ;
156 N TEMP
157 S TEMP=NAME_U_SOURCE
158 S DATE=$$FMTE^XLFDT(DATE,"5Z")
159 S TEMP=TEMP_U_DATE
160 D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
161 Q
162 ;
163 ;======================================================
164HDR ;List Manager HEADER entry point.
165 S VALMHDR(1)="Exchange File Entry History."
166 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
167 Q
168 ;
169 ;======================================================
170HELP ;Help code
171 W !,"Select DH to delete install histories."
172 W !,"Select ID to see the details of an install."
173 D PAUSE^VALM1
174 Q
175 ;
176 ;======================================================
177IHIST ;Get a list of repository entries and show their installation history.
178 N PXRMRIEN,VALMCNT,VALMY
179 D EN^VALM2(XQORNOD(0))
180 ;If there is no list quit.
181 I '$D(VALMY) Q
182 S IND=""
183 F S IND=$O(VALMY(IND)) Q:IND="" D
184 . S PXRMRIEN=^TMP("PXRMEXLR",$J,"SEL",IND)
185 . D EN^VALM("PXRM EX INSTALLATION HISTORY")
186 S VALMBCK="R"
187 Q
188 ;
189 ;=====================================================
190PEXIT ;PXRM EXCH SELECT HISTORY protocol exit code
191 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
192 ;Reset after page up/down etc
193 D XQORM
194 Q
195 ;
196 ;======================================================
197START ;Main entry point for installation history. The Exchange File IEN is
198 ;PXRMRIEN.
199 N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
200 S X="IORESET"
201 D ENDR^%ZISS
202 S VALMCNT=0
203 D EN^VALM("PXRM EX INSTALLATION HISTORY")
204 Q
205 ;
206 ;======================================================
207XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT HISTORY",0))_U_"1:"_VALMCNT
208 S XQORM("A")="Select Action: "
209 Q
210 ;
211 ;======================================================
212XSEL ;PXRM EXCH SELECT HISTORY validation
213 N ARRAY,CNT,SEL,SELECT
214 S SELECT=$P(XQORNOD(0),"=",2)
215 I '$$VALID^PXRMEXLD(SELECT) S VALMBCK="R" Q
216 ;Build array of selected items
217 F CNT=1:1 S SEL=$P(SELECT,",",CNT) Q:'SEL S ARRAY(SEL)=""
218 ;
219 D FULL^VALM1
220 ;
221 ;Option to display installation details or delete install history.
222 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
223 S DIR(0)="SBM"_U_"DH:Delete Install History;"
224 S DIR(0)=DIR(0)_"ID:Installation Details;"
225 S DIR("A")="Select Action: "
226 S DIR("B")="ID"
227 S DIR("?")="Select from the codes displayed."
228 D ^DIR
229 I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
230 I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
231 S OPTION=Y
232 ;
233 ;Display installation details.
234 I OPTION="ID" D DDISP(.ARRAY)
235 ;
236 ;Delete installation history.
237 I OPTION="DH" D DELETE(.ARRAY)
238 S VALMBCK="R"
239 Q
240 ;
Note: See TracBrowser for help on using the repository browser.