source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGJMN1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 8.6 KB
Line 
1MAGJMN1 ;WIRMFO/JHC VRad Maint functions ; 29 Jul 2003 4:02 PM
2 ;;3.0;IMAGING;**16,9,22,18,65,76**;Jun 22, 2007;Build 19
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20 ;
21SVRLIST ;
22 W @IOF,!!?10,"Enter/Edit VistARad Exams List Definition",!!
23 N MAGIEN
24 K DIC S (DIC,DLAYGO)=2006.631,DIC(0)="ALMEQ"
25 D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q
26 S X=$P(@(DIC_+Y_",0)"),U,2)
27 I X>9000 W !!,$C(7),"You may not edit System-Supplied files!" H 3 G SVRLIST
28 S DIE=2006.631,DA=+Y,DR="[MAGJ LIST EDIT]"
29 S MAGIEN=DA
30 D ^DIE I '$D(DA) G SVRLIST
31 D ENSRCH
32 D BLDDEF(MAGIEN)
33 S $P(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT()
34 W !!,"List Definition complete!" R X:2
35 G SVRLIST
36 Q
37ENSRCH ; Invoke Search for 2006.631 def'n
38 N GREF,GLIN,GO,CT,DIARI,DIC,FNOD,TNOD,NCOND,NODE0
39 ; GREF holds indirect ref to store search logic data:
40 ; @GREF@(3, ff -- conditional elements (fields/logic)
41 ; @GREF@(4, ff -- composite elements (ANDed conditions)
42 ; @GREF@(5, ff -- Human-readable search text
43 ; GLIN holds indirect ref to retrieve search logic data from ^DIBT
44 ; @GLIN@("DC", ff -- conditional elements
45 ; @GLIN@("DL", ff -- composite elements
46 ; @GLIN@("O", ff -- readable text
47 S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF"))
48 S GO=1 I $D(@GREF@(5,1)) D ; show current logic
49 . W ! D DISPSRCH(GREF)
50 . S X=$$YN("Do you want to delete or re-enter the search logic?","NO")
51 . I X'="Y" S GO=0 Q
52 . W !!?7,"Re-entering the search logic requires first deleting the current",!?7,"definition, then entering the new definition from scratch."
53 . S X=$$YN("Are you sure you want to continue?","NO")
54 . I X'="Y" S GO=0 Q
55 I 'GO Q
56 W !!?7,"Now enter search logic for this List. To do this, the program"
57 W !?7,"will prompt you just as if you were going to run a Fileman Search."
58 W !?7,"When prompted STORE RESULTS OF SEARCH IN TEMPLATE:, answer with 'TEMP'"
59 W !?7,"If prompted ... OK TO PURGE? NO// answer 'YES'; don't bother specifying"
60 W !?7,"output print fields, but just RETURN through all the prompts to"
61 W !?7,"complete the process. The search definition will be saved as part"
62 W !?7,"of this List definition; you will test it out by running it from "
63 W !?7,"the workstation. If you need to modify the search logic, you will"
64 W !?7,"have to re-enter it in its entirety."
65 W !!?7,"NOTES: EXAM LOCK INDICATOR will not work for search logic;"
66 W !?14,"REMOTE CACHE INDICATOR only works for Null/Not Null logic."
67 S DIC=2006.634 D EN^DIS ; call Fman Search Logic routine. It will store search logic in ^DIBT
68 ; 2006.634 is intentional--don't change this!
69 I '$G(DIARI) W !!," Search logic NOT updated" D Q
70 . Q:'$D(@GREF@(5,1)) ; if no logic had existed, quit
71 . S X=$$YN("Do you want to DELETE the search logic?","NO")
72 . I X="Y" K @GREF@(3) K ^(4),^(5) W " -- Deleted!"
73 K @GREF@(3) K ^(4),^(5)
74 S GLIN=$NA(^DIBT(DIARI)) ; Copy logic to 2006.631 DEF nodes
75 S FNOD="DC",TNOD=3,CT=0 ; "DC" data--straight copy
76 S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T),CT=CT+1,@GREF@(TNOD,T)=X
77 S @GREF@(TNOD,0)=CT
78 S FNOD="DL",TNOD=4,CT=0 ; "DL" data--copy depends on storage scheme in DIBT:
79 ;Zero node null -- straight copy
80 ; Else 1) either only one condition is defined;
81 ; or, 2) the zero-node condition is ANDed with all defined conditions
82 ; Case 2: Var A -- Pre-pend zero node, then dup zero node
83 ; Var B -- Pre-pend zero node
84 S NCOND=+$G(@GLIN@(FNOD))
85 I $G(@GLIN@(FNOD,0))]"" S NODE0=^(0) D
86 . S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T) I X]"" S CT=CT+1,@GREF@(TNOD,CT)=NODE0_X
87 . I CT'=NCOND S CT=CT+1,@GREF@(TNOD,CT)=NODE0_$S(CT=1:"",1:"^")
88 E D
89 . S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T) I X]"" S CT=CT+1,@GREF@(TNOD,CT)=X
90 S @GREF@(TNOD,0)=CT
91 ; readable text--straight copy
92 S TNOD=5,T=0 F S T=$O(@GLIN@("O",T)) Q:T="" S @GREF@(TNOD,T)=^(T,0)
93 Q
94 ;
95BLDDEF(LSTID) ; build DEF nodes for Column/Sort defs
96 N QX,SS,STR,LSTHDR,T,T0,T8,T6,HASCASE,XT,HASDATE
97 S SS=0,HASCASE=0,HASDATE=0
98 ; columns/hdrs: Order in T array by the Relative Column Order
99 F S SS=$O(^MAG(2006.631,LSTID,1,SS)) D Q:'SS
100 . I 'SS D Q
101 . . I 'HASCASE S X=1 D BLDDEF2(X) ; FORCE CASE#
102 . . I 'HASDATE S X=7 D BLDDEF2(X) ; DATE/TIME
103 . E S X=^MAG(2006.631,LSTID,1,SS,0)
104 . D BLDDEF2(X)
105 ; go thru T to build ordered field sequence for output columns
106 S QX="T",STR="",LSTHDR=""
107 F S QX=$Q(@QX) Q:QX="" S X=@QX D
108 . S STR=STR_$S(STR="":"",1:U)_$P(X,U)
109 . S LSTHDR=LSTHDR_$S(LSTHDR="":"",1:U)_$P(X,U,2)
110 S ^MAG(2006.631,LSTID,"DEF",.5)=LSTHDR,^(1)=STR
111 ; Sort values:
112 S SS=0,STR=""
113 F S SS=$O(^MAG(2006.631,LSTID,2,SS)) Q:'SS S X=^(SS,0) D
114 . S X=+X_$S($P(X,U,2):"-",1:"")
115 . S STR=STR_$S(STR="":"",1:U)_X
116 S ^MAG(2006.631,LSTID,"DEF",2)=STR
117 S $P(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT()
118 Q
119 ;
120BLDDEF2(X) ;
121 S X=+X_$S($P(X,U,2):";"_+$P(X,U,2),1:"")
122 I 'HASCASE S HASCASE=(+X=1)
123 I 'HASDATE S HASDATE=(+X=7)
124 S T0=^MAG(2006.63,+X,0),T6=+$P(T0,U,6) S:'T6 T6=99
125 S T8=$P(T0,U,8) I T8]"" S T8="~"_T8
126 S XT=$S($P(T0,U,3)]"":$P(T0,U,3),1:$P(T0,U,2))_T8
127 S $P(XT,"~",3)=+X
128 S T(T6,+X)=X_U_XT
129 Q
130 ;
131PRE ; init 2006.63 prior to KIDS install
132 N DIK,DA S DIK="^MAG(2006.63,",DA=0 F S DA=$O(@(DIK_DA_")")) Q:'DA D ^DIK
133 Q
134 ;
135P18 ; Patch 18 inits
136 D BLDALL
137 D POST
138 Q
139 ;
140BLDALL ; Create "DEF" nodes, Button labels List Def'ns
141 ; Updates all lists after s/w update list defs are installed
142 N SS,LSTDAT,LSTNUM,BUTTON,LSTTYP
143 S SS=0
144 F S SS=$O(^MAG(2006.631,SS)) Q:'SS S LSTDAT=$G(^(SS,0)) I LSTDAT]"" D
145 . S LSTNUM=$P(LSTDAT,U,2),BUTTON=$P(LSTDAT,U,7),LSTTYP=$P(LSTDAT,U,3)
146 . I LSTNUM>9900!$P(LSTDAT,U,6) D BLDDEF(SS) ; build DEF nodes for System Lists & any Enabled lists
147 . I BUTTON="",(LSTTYP]"") D ; Create Button Labels if needed
148 . . S BUTTON=$S(LSTTYP="U":"Unread #",LSTTYP="R":"Recent #",LSTTYP="A":"All Active #",LSTTYP="P":"Pending #",1:"List #")_LSTNUM
149 . . S $P(^MAG(2006.631,SS,0),U,7)=BUTTON
150 Q
151 ;
152POST ; Install msg
153 D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
154 Q
155 ;
156YN(MSG,DFLT) ; get Yes/No reply
157 N X I $G(DFLT)="" S DFLT="N"
158 W !
159 S DFLT=$E(DFLT),DFLT=$S(DFLT="N":"NO",1:"YES")
160YN1 W !,MSG_" "_DFLT_"// "
161 R X:DTIME S:X="" X=DFLT S X=$E(X),X=$TR(X,"ynYN","YNYN")
162 I "YN"'[X W " ??? Enter YES or NO",! G YN1
163 Q X
164 ;
165LSTINQ ; Inq/Disp list def'n
166 N GREF,MAGIEN
167 W !!?15,"Display VistARad Exams List Definition",!!
168 N MAGIEN
169 S DIC=2006.631,DIC(0)="AMEQ"
170 D ^DIC I Y=-1 K DIC,DA,DR Q
171 K DR S DA=+Y,MAGIEN=DA
172 S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF"))
173 W ! D EN^DIQ
174 R !,"Enter RETURN to display the Search Logic: ",X:DTIME W !
175 D DISPSRCH(GREF)
176 G LSTINQ
177 Q
178 ;
179DISPSRCH(GREF) ; GREF holds indirect ref for global holding search logic data
180 I $D(@GREF@(5,1)) W !,"List Exams where:",! D
181 . F I=1:1 Q:'$D(@GREF@(5,I)) W !?3,^(I)
182 E W !?3,"NO Search Logic defined!"
183 Q
184 ;
185VRSIT ;
186 W @IOF,!!?10,"Enter/Edit VistARad Site Parameters",!!
187 S DIC=2006.69,DIC(0)="ALMEQ"
188 I '$D(^MAG(DIC,1)) S DLAYGO=DIC
189 D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q
190 S DIE=2006.69,DA=+Y,DR=".01:3.99;4.1:20"
191 D ^DIE
192 K DIC,DA,DR,DIE,DLAYGO
193 N PLACE S DA=""
194 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
195 S:PLACE DA=PLACE
196 I DA D
197 . W !!,"Editing VistARad Timeout for division #",DUZ(2),!
198 . S DIE=2006.1,DR="123" D ^DIE
199 K DA,DR,DIE
200 Q
201 ;
202EEPREF ;
203 W @IOF,!!?10,"Enter/Edit VistARad Prefetch Logic",!!
204 N MAGIEN
205 K DIC S (DIC,DLAYGO)=2006.65,DIC(0)="ALMEQ"
206 D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q
207 S DIE=2006.65,DA=+Y,DR="[MAGJ PRIOR EDIT]"
208 S MAGIEN=DA
209 D ^DIE I '$D(DA) G EEPREF
210 G EEPREF
211 Q
212INPREF ; Inquire VRad PreFetch
213 W @IOF,!!?10,"Inquire VistARad Prefetch Logic",!!
214 N MAGIEN,BY,FR,TO
215 S DIC=2006.65,DIC(0)="AMEQ"
216 D ^DIC I Y=-1 K DIC Q
217 S DA=+Y,(FR,TO)=$P(Y,U,2),MAGIEN=DA,L=0
218 S BY="[MAGJ PRIOR SORT]",DIS(0)="I D0=MAGIEN"
219 D EN^DIP
220 R !,"Enter RETURN to continue: ",X:DTIME W !
221 G INPREF
222 Q
223PRPREF ;Print VRad Prefetch
224 N BY
225 W !! S DIC=2006.65,L=0,BY="[MAGJ PRIOR SORT]"
226 D EN1^DIP
227 R !,"Enter RETURN to continue: ",X:DTIME W !
228 Q
229 ;
230END ;
Note: See TracBrowser for help on using the repository browser.