Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJMN1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJMN1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJMN1.m
r613 r623 1 MAGJMN1 2 ;;3.0;IMAGING;**16,9,22,18,65,76**;Jun 22, 2007;Build 19 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 SVRLIST 22 23 24 25 26 27 28 29 30 31 32 33 S $P(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT() 34 35 36 37 ENSRCH 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 BLDDEF(LSTID) 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 S $P(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT() 118 119 120 BLDDEF2(X) 121 122 123 124 125 126 127 128 129 130 131 PRE 132 133 134 135 P18 136 137 138 139 140 BLDALL 141 142 143 144 145 146 147 148 149 150 151 152 POST 153 154 155 156 YN(MSG,DFLT) 157 158 159 160 YN1 161 162 163 164 165 LSTINQ 166 167 168 169 170 171 172 173 174 175 176 177 178 179 DISPSRCH(GREF) 180 181 182 183 184 185 VRSIT 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 EEPREF 203 204 205 206 207 208 209 210 211 212 INPREF 213 214 215 216 217 218 219 220 221 222 223 PRPREF 224 225 226 227 228 229 230 END 1 MAGJMN1 ;WIRMFO/JHC VRad Maint functions ; 29 Jul 2003 4:02 PM 2 ;;3.0;IMAGING;**16,9,22,18,65**;Jul 27, 2006;Build 28 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 ; 21 SVRLIST ; 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 D NOW^%DTC S $P(^MAG(2006.631,MAGIEN,0),U,5)=% 34 W !!,"List Definition complete!" R X:2 35 G SVRLIST 36 Q 37 ENSRCH ; 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 ; 95 BLDDEF(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 D NOW^%DTC S $P(^MAG(2006.631,LSTID,"DEF",0),U)=% 118 Q 119 ; 120 BLDDEF2(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 ; 131 PRE ; 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 ; 135 P18 ; Patch 18 inits 136 D BLDALL 137 D POST 138 Q 139 ; 140 BLDALL ; 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 ; 152 POST ; Install msg 153 D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA) 154 Q 155 ; 156 YN(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") 160 YN1 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 ; 165 LSTINQ ; 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 ; 179 DISPSRCH(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 ; 185 VRSIT ; 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 ; 202 EEPREF ; 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 212 INPREF ; 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 223 PRPREF ;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 ; 230 END ;
Note:
See TracChangeset
for help on using the changeset viewer.
