| [623] | 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 ;
|
|---|
