MAGJMN1 ;WIRMFO/JHC - VRad Maint functions ; 10 Sep 2014 10:35 AM
;;3.0;IMAGING;**16,9,22,18,65,76,101,90,115,120,133,152,153**;Mar 19, 2002;Build 16;Jul 05, 2015
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
ENVCHK ; "Environment Check" for KIDS Install
I 'XPDENV Q ; Proceed only if in Install phase
N MAGJKIDS S MAGJKIDS=1
D BGCSTOP
Q
;
SVRLIST ;
W @IOF,!!?10,"Enter/Edit VistARad Exams List Definition",!!
N MAGIEN
K DIC S (DIC,DLAYGO)=2006.631,DIC(0)="ALMEQ"
D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q
S X=$P(@(DIC_+Y_",0)"),U,2)
I X>9000 W !!,$C(7),"You may not edit System-Supplied files!" H 3 G SVRLIST
S DIE=2006.631,DA=+Y,DR="[MAGJ LIST EDIT]"
S MAGIEN=DA
D ^DIE I '$D(DA) G SVRLIST
D ENSRCH
D BLDDEF(MAGIEN)
S $P(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT()
W !!,"List Definition complete!" R X:2
G SVRLIST
Q
ENSRCH ; Invoke Search for 2006.631 def'n
N GREF,GLIN,GO,CT,DIARI,DIC,FNOD,TNOD,NCOND,NODE0
; GREF holds indirect ref to store search logic data:
; @GREF@(3, ff -- conditional elements (fields/logic)
; @GREF@(4, ff -- composite elements (ANDed conditions)
; @GREF@(5, ff -- Human-readable search text
; GLIN holds indirect ref to retrieve search logic data from ^DIBT
; @GLIN@("DC", ff -- conditional elements
; @GLIN@("DL", ff -- composite elements
; @GLIN@("O", ff -- readable text
S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF"))
S GO=1 I $D(@GREF@(5,1)) D ; show current logic
. W ! D DISPSRCH(GREF)
. S X=$$YN("Do you want to delete or re-enter the search logic?","NO")
. I X'="Y" S GO=0 Q
. W !!?7,"Re-entering the search logic requires first deleting the current",!?7,"definition, then entering the new definition from scratch."
. S X=$$YN("Are you sure you want to continue?","NO")
. I X'="Y" S GO=0 Q
I 'GO Q
W !!?7,"Now enter search logic for this List. To do this, the program"
W !?7,"will prompt you just as if you were going to run a Fileman Search."
W !?7,"When prompted STORE RESULTS OF SEARCH IN TEMPLATE:, answer with 'TEMP'"
W !?7,"If prompted ... OK TO PURGE? NO// answer 'YES'; don't bother specifying"
W !?7,"output print fields, but just RETURN through all the prompts to"
W !?7,"complete the process. The search definition will be saved as part"
W !?7,"of this List definition; you will test it out by running it from "
W !?7,"the workstation. If you need to modify the search logic, you will"
W !?7,"have to re-enter it in its entirety."
W !!?7,"NOTES: EXAM LOCK INDICATOR will not work for search logic;"
W !?14,"REMOTE CACHE INDICATOR only works for Null/Not Null logic."
S DIC=2006.634 D EN^DIS ; call Fman Search Logic routine. It will store search logic in ^DIBT
; 2006.634 is intentional--don't change this!
I '$G(DIARI) W !!," Search logic NOT updated" D Q
. Q:'$D(@GREF@(5,1)) ; if no logic had existed, quit
. S X=$$YN("Do you want to DELETE the search logic?","NO")
. I X="Y" K @GREF@(3) K ^(4),^(5) W " -- Deleted!"
K @GREF@(3) K ^(4),^(5)
S GLIN=$NA(^DIBT(DIARI)) ; Copy logic to 2006.631 DEF nodes
S FNOD="DC",TNOD=3,CT=0 ; "DC" data--straight copy
S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T),CT=CT+1,@GREF@(TNOD,T)=X
S @GREF@(TNOD,0)=CT
S FNOD="DL",TNOD=4,CT=0 ; "DL" data--copy depends on storage scheme in DIBT:
;Zero node null -- straight copy
; Else 1) either only one condition is defined;
; or, 2) the zero-node condition is ANDed with all defined conditions
; Case 2: Var A -- Pre-pend zero node, then dup zero node
; Var B -- Pre-pend zero node
S NCOND=+$G(@GLIN@(FNOD))
I $G(@GLIN@(FNOD,0))]"" S NODE0=^(0) D
. 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
. I CT'=NCOND S CT=CT+1,@GREF@(TNOD,CT)=NODE0_$S(CT=1:"",1:"^")
E D
. 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
S @GREF@(TNOD,0)=CT
; readable text--straight copy
S TNOD=5,T=0 F S T=$O(@GLIN@("O",T)) Q:T="" S @GREF@(TNOD,T)=^(T,0)
Q
;
BLDDEF(LSTID) ; build DEF nodes for Column/Sort defs
N X,QX,SS,STR,LSTHDR,T,T0,T8,T6,HASCASE,XT,HASDATE,HASNIMG,HASPRIO,HASLOCK,LISTYPE
S SS=0,HASCASE=0,HASDATE=0,HASNIMG=0,HASPRIO=0,HASLOCK=0
S LISTYPE=$P($G(^MAG(2006.631,LSTID,0)),U,3)
; columns/hdrs: Order in T array by the Relative Column Order
F S SS=$O(^MAG(2006.631,LSTID,1,SS)) D Q:'SS
. I 'SS D Q
. . I 'HASCASE S X=1 D BLDDEF2(X) ; Force CASE#
. . I 'HASDATE S X=7 D BLDDEF2(X) ; DATE/TIME
. . I 'HASNIMG S X=9 D BLDDEF2(X) ; NUMBER IMAGES
. . Q:LISTYPE'="U" ; force below only if for an Unread list
. . I 'HASLOCK S X=2 D BLDDEF2(X) ; EXAM LOCK IND.
. . I 'HASPRIO S X=5 D BLDDEF2(X) ; PRIORITY
. E S X=^MAG(2006.631,LSTID,1,SS,0)
. D BLDDEF2(X)
; go thru T to build ordered field sequence for output columns
S QX="T",STR="",LSTHDR=""
F S QX=$Q(@QX) Q:QX="" S X=@QX D
. S STR=STR_$S(STR="":"",1:U)_$P(X,U)
. S LSTHDR=LSTHDR_$S(LSTHDR="":"",1:U)_$P(X,U,2)
S ^MAG(2006.631,LSTID,"DEF",.5)=LSTHDR,^(1)=STR
; Sort values:
S SS=0,STR=""
F S SS=$O(^MAG(2006.631,LSTID,2,SS)) Q:'SS S X=^(SS,0) D
. S X=+X_$S($P(X,U,2):"-",1:"")
. S STR=STR_$S(STR="":"",1:U)_X
S ^MAG(2006.631,LSTID,"DEF",2)=STR
S $P(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT()
Q
;
BLDDEF2(X) ;
S X=+X_$S($P(X,U,2):";"_+$P(X,U,2),1:"")
I 'HASCASE S HASCASE=(+X=1)
I 'HASDATE S HASDATE=(+X=7)
I 'HASNIMG S HASNIMG=(+X=9)
I 'HASLOCK S HASLOCK=(+X=2)
I 'HASPRIO S HASPRIO=(+X=5)
S T0=^MAG(2006.63,+X,0),T6=+$P(T0,U,6) S:'T6 T6=99
S T8=$P(T0,U,8) I T8]"" S T8="~"_T8
S XT=$S($P(T0,U,3)]"":$P(T0,U,3),1:$P(T0,U,2))_T8
S $P(XT,"~",3)=+X
S T(T6,+X)=X_U_XT
Q
;
POSTINST ; Patch installation inits, etc.
; D BLDALL ; update list definitions <*> Use any time fields are added
D BGCSTRT ; re-start background compile
D POST ; install message, etc.
Q
;
BLDALL ; Create "DEF" nodes, Button labels List Def'ns
; Updates all lists after s/w update list defs are installed
N SS,LSTDAT,LSTNUM,BUTTON,LSTTYP
S SS=0
F S SS=$O(^MAG(2006.631,SS)) Q:'SS S LSTDAT=$G(^(SS,0)) I LSTDAT]"" D
. S LSTNUM=$P(LSTDAT,U,2),BUTTON=$P(LSTDAT,U,7),LSTTYP=$P(LSTDAT,U,3)
. I LSTNUM>9900!$P(LSTDAT,U,6) D BLDDEF(SS) ; build DEF nodes for System Lists & any Enabled lists
. I BUTTON="",(LSTTYP]"") D ; Create Button Labels if needed
. . S BUTTON=$S(LSTTYP="U":"Unread #",LSTTYP="R":"Recent #",LSTTYP="A":"All Active #",LSTTYP="P":"Pending #",1:"List #")_LSTNUM
. . S $P(^MAG(2006.631,SS,0),U,7)=BUTTON
Q
;
POST ; Install msg
D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
Q
;
YN(MSG,DFLT) ; get Yes/No reply
N X I $G(DFLT)="" S DFLT="N"
W !
S DFLT=$E(DFLT),DFLT=$S(DFLT="N":"NO",1:"YES")
YN1 W !,MSG_" "_DFLT_"// "
R X:DTIME S:X="" X=DFLT S X=$E(X),X=$TR(X,"ynYN","YNYN")
I "YN"'[X W " ??? Enter YES or NO",! G YN1
Q X
;
LSTINQ ; Inq/Disp list def'n
N GREF,MAGIEN
W !!?15,"Display VistARad Exams List Definition",!!
N MAGIEN
S DIC=2006.631,DIC(0)="AMEQ"
D ^DIC I Y=-1 K DIC,DA,DR Q
K DR S DA=+Y,MAGIEN=DA
S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF"))
W ! D EN^DIQ
R !,"Enter RETURN to display the Search Logic: ",X:DTIME W !
D DISPSRCH(GREF)
G LSTINQ
Q
;
DISPSRCH(GREF) ; GREF holds indirect ref for global holding search logic data
I $D(@GREF@(5,1)) W !,"List Exams where:",! D
. F I=1:1 Q:'$D(@GREF@(5,I)) W !?3,^(I)
E W !?3,"NO Search Logic defined!"
Q
;
VRSIT ;
W @IOF,!!?10,"Enter/Edit VistARad Site Parameters",!!
S DIC=2006.69,DIC(0)="ALMEQ"
I '$D(^MAG(DIC,1)) S DLAYGO=DIC
D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q
S DIE=2006.69,DA=+Y,DR=".01:20"
D ^DIE
K DIC,DA,DR,DIE,DLAYGO
N PLACE S DA=""
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S:PLACE DA=PLACE
I DA D
. W !!,"Editing VistARad Timeout for division #",DUZ(2),!
. S DIE=2006.1,DR="123" D ^DIE
K DA,DR,DIE
Q
;
;+++++ OPTION: MAGJ E/E DEFAULT USER PROFILES
;
; FileMan ^DIE call to enter/edit IMAGING SITE PARAMETERS File (#2006.1),
; fields #202: DEFAULT VISTARAD USERPREF RAD and
; #203: DEFAULT VISTARAD USERPREF NON.
;
; These fields point to entries in the MAGJ USER DATA File (#2006.68), and
; allow the VistARad client to initialize new VistARad users to the settings
; held by the appropriate default user type ("Radiologist", "Non-rad'ist").
;
EEPRO ;
;
;--- Get IEN of IMAGING SITE PARAMETERS File.
N FIELD,SITEPIEN S SITEPIEN=+$$IMGSIT^MAGJUTL1(DUZ(2),1)
F FIELD=202,203 D
. ;
. ;--- Report field being edited.
. N PROMPT S PROMPT=$S(FIELD=202:"RADIOLOGIST",FIELD=203:"NON-RADIOLOGIST")
. W !!,"Editing default "_PROMPT_" profile ...",!
. N DA,DIE,DR
. S DIE=2006.1,DR=FIELD,DA=SITEPIEN D ^DIE
. Q
Q
EEPREF ;
W @IOF,!!?10,"Enter/Edit VistARad Prefetch Logic",!!
N MAGIEN
K DIC S (DIC,DLAYGO)=2006.65,DIC(0)="ALMEQ"
D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q
S DIE=2006.65,DA=+Y,DR="[MAGJ PRIOR EDIT]"
S MAGIEN=DA
D ^DIE I '$D(DA) G EEPREF
G EEPREF
Q
INPREF ; Inquire VRad PreFetch
W @IOF,!!?10,"Inquire VistARad Prefetch Logic",!!
N MAGIEN,BY,FR,TO
S DIC=2006.65,DIC(0)="AMEQ"
D ^DIC I Y=-1 K DIC Q
S DA=+Y,(FR,TO)=$P(Y,U,2),MAGIEN=DA,L=0
S BY="[MAGJ PRIOR SORT]",DIS(0)="I D0=MAGIEN"
D EN^DIP
R !,"Enter RETURN to continue: ",X:DTIME W !
G INPREF
Q
PRPREF ;Print VRad Prefetch
N BY
W !! S DIC=2006.65,L=0,BY="[MAGJ PRIOR SORT]"
D EN1^DIP
R !,"Enter RETURN to continue: ",X:DTIME W !
Q
;
BGCSTOP ; Stop Background Compile program
N MAGCSTRT,GO,NTRY,RETRY,X
S MAGCSTRT=0,GO=1
S X=$G(^MAG(2006.69,1,0))
I X]"",+$P(X,U,8) D ; Background compile switch; skip if already false
. S ^MAG(2006.69,"BGSTOP")=X ; save current settings for restore later
. S MAGCSTRT=1
. S $P(X,U,8)=0
. S ^MAG(2006.69,1,0)=X ; disable compile
. W !!,*7,"Wait for Background Compile program to stop;"
. W !," this might take up to a few minutes."
. S NTRY=60
. F I=1:1:NTRY W "." L +^XTMP("MAGJ2","BKGND2","RUN"):3 I Q ; process maintains lock while running
. I D
. . L -^XTMP("MAGJ2","BKGND2","RUN")
. . W !!,"Background Compile Stopped"
. . I +$G(MAGJKIDS) W "; proceeding with install.",! H 2
. E D
. . S X=$$YN("Background Compile NOT Stopped -- Try again?","Y")
. . S RETRY=("Y"[X),GO=0
. . S ^MAG(2006.69,1,0)=^MAG(2006.69,"BGSTOP") K ^MAG(2006.69,"BGSTOP")
I 'GO G BGCSTOP:RETRY
I 'GO,+$G(MAGJKIDS) W !!,*7," * * * Exiting out of patch installation * * * ",! H 3 S XPDQUIT=1
Q
BGCSTRT ; re-enable Background Compile
I $D(^MAG(2006.69,"BGSTOP")) S X=^("BGSTOP") W " ... Enabling background compile ."
E Q
S ^MAG(2006.69,1,0)=X
K ^MAG(2006.69,"BGSTOP")
W !!,"Background Compile Enabled.",! H 3
Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJMN1 11713 printed Sep 23, 2025@19:43:07 Page 2
MAGJMN1 ;WIRMFO/JHC - VRad Maint functions ; 10 Sep 2014 10:35 AM
+1 ;;3.0;IMAGING;**16,9,22,18,65,76,101,90,115,120,133,152,153**;Mar 19, 2002;Build 16;Jul 05, 2015
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
ENVCHK ; "Environment Check" for KIDS Install
+1 ; Proceed only if in Install phase
IF 'XPDENV
QUIT
+2 NEW MAGJKIDS
SET MAGJKIDS=1
+3 DO BGCSTOP
+4 QUIT
+5 ;
SVRLIST ;
+1 WRITE @IOF,!!?10,"Enter/Edit VistARad Exams List Definition",!!
+2 NEW MAGIEN
+3 KILL DIC
SET (DIC,DLAYGO)=2006.631
SET DIC(0)="ALMEQ"
+4 DO ^DIC
IF Y=-1
KILL DIC,DA,DR,DIE,DLAYGO
QUIT
+5 SET X=$PIECE(@(DIC_+Y_",0)"),U,2)
+6 IF X>9000
WRITE !!,$CHAR(7),"You may not edit System-Supplied files!"
HANG 3
GOTO SVRLIST
+7 SET DIE=2006.631
SET DA=+Y
SET DR="[MAGJ LIST EDIT]"
+8 SET MAGIEN=DA
+9 DO ^DIE
IF '$DATA(DA)
GOTO SVRLIST
+10 DO ENSRCH
+11 DO BLDDEF(MAGIEN)
+12 SET $PIECE(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT()
+13 WRITE !!,"List Definition complete!"
READ X:2
+14 GOTO SVRLIST
+15 QUIT
ENSRCH ; Invoke Search for 2006.631 def'n
+1 NEW GREF,GLIN,GO,CT,DIARI,DIC,FNOD,TNOD,NCOND,NODE0
+2 ; GREF holds indirect ref to store search logic data:
+3 ; @GREF@(3, ff -- conditional elements (fields/logic)
+4 ; @GREF@(4, ff -- composite elements (ANDed conditions)
+5 ; @GREF@(5, ff -- Human-readable search text
+6 ; GLIN holds indirect ref to retrieve search logic data from ^DIBT
+7 ; @GLIN@("DC", ff -- conditional elements
+8 ; @GLIN@("DL", ff -- composite elements
+9 ; @GLIN@("O", ff -- readable text
+10 SET GREF=$NAME(^MAG(2006.631,MAGIEN,"DEF"))
+11 ; show current logic
SET GO=1
IF $DATA(@GREF@(5,1))
Begin DoDot:1
+12 WRITE !
DO DISPSRCH(GREF)
+13 SET X=$$YN("Do you want to delete or re-enter the search logic?","NO")
+14 IF X'="Y"
SET GO=0
QUIT
+15 WRITE !!?7,"Re-entering the search logic requires first deleting the current",!?7,"definition, then entering the new definition from scratch."
+16 SET X=$$YN("Are you sure you want to continue?","NO")
+17 IF X'="Y"
SET GO=0
QUIT
End DoDot:1
+18 IF 'GO
QUIT
+19 WRITE !!?7,"Now enter search logic for this List. To do this, the program"
+20 WRITE !?7,"will prompt you just as if you were going to run a Fileman Search."
+21 WRITE !?7,"When prompted STORE RESULTS OF SEARCH IN TEMPLATE:, answer with 'TEMP'"
+22 WRITE !?7,"If prompted ... OK TO PURGE? NO// answer 'YES'; don't bother specifying"
+23 WRITE !?7,"output print fields, but just RETURN through all the prompts to"
+24 WRITE !?7,"complete the process. The search definition will be saved as part"
+25 WRITE !?7,"of this List definition; you will test it out by running it from "
+26 WRITE !?7,"the workstation. If you need to modify the search logic, you will"
+27 WRITE !?7,"have to re-enter it in its entirety."
+28 WRITE !!?7,"NOTES: EXAM LOCK INDICATOR will not work for search logic;"
+29 WRITE !?14,"REMOTE CACHE INDICATOR only works for Null/Not Null logic."
+30 ; call Fman Search Logic routine. It will store search logic in ^DIBT
SET DIC=2006.634
DO EN^DIS
+31 ; 2006.634 is intentional--don't change this!
+32 IF '$GET(DIARI)
WRITE !!," Search logic NOT updated"
Begin DoDot:1
+33 ; if no logic had existed, quit
if '$DATA(@GREF@(5,1))
QUIT
+34 SET X=$$YN("Do you want to DELETE the search logic?","NO")
+35 IF X="Y"
KILL @GREF@(3)
KILL ^(4),^(5)
WRITE " -- Deleted!"
End DoDot:1
QUIT
+36 KILL @GREF@(3)
KILL ^(4),^(5)
+37 ; Copy logic to 2006.631 DEF nodes
SET GLIN=$NAME(^DIBT(DIARI))
+38 ; "DC" data--straight copy
SET FNOD="DC"
SET TNOD=3
SET CT=0
+39 SET T=0
FOR
SET T=$ORDER(@GLIN@(FNOD,T))
if T=""
QUIT
SET X=^(T)
SET CT=CT+1
SET @GREF@(TNOD,T)=X
+40 SET @GREF@(TNOD,0)=CT
+41 ; "DL" data--copy depends on storage scheme in DIBT:
SET FNOD="DL"
SET TNOD=4
SET CT=0
+42 ;Zero node null -- straight copy
+43 ; Else 1) either only one condition is defined;
+44 ; or, 2) the zero-node condition is ANDed with all defined conditions
+45 ; Case 2: Var A -- Pre-pend zero node, then dup zero node
+46 ; Var B -- Pre-pend zero node
+47 SET NCOND=+$GET(@GLIN@(FNOD))
+48 IF $GET(@GLIN@(FNOD,0))]""
SET NODE0=^(0)
Begin DoDot:1
+49 SET T=0
FOR
SET T=$ORDER(@GLIN@(FNOD,T))
if T=""
QUIT
SET X=^(T)
IF X]""
SET CT=CT+1
SET @GREF@(TNOD,CT)=NODE0_X
+50 IF CT'=NCOND
SET CT=CT+1
SET @GREF@(TNOD,CT)=NODE0_$SELECT(CT=1:"",1:"^")
End DoDot:1
+51 IF '$TEST
Begin DoDot:1
+52 SET T=0
FOR
SET T=$ORDER(@GLIN@(FNOD,T))
if T=""
QUIT
SET X=^(T)
IF X]""
SET CT=CT+1
SET @GREF@(TNOD,CT)=X
End DoDot:1
+53 SET @GREF@(TNOD,0)=CT
+54 ; readable text--straight copy
+55 SET TNOD=5
SET T=0
FOR
SET T=$ORDER(@GLIN@("O",T))
if T=""
QUIT
SET @GREF@(TNOD,T)=^(T,0)
+56 QUIT
+57 ;
BLDDEF(LSTID) ; build DEF nodes for Column/Sort defs
+1 NEW X,QX,SS,STR,LSTHDR,T,T0,T8,T6,HASCASE,XT,HASDATE,HASNIMG,HASPRIO,HASLOCK,LISTYPE
+2 SET SS=0
SET HASCASE=0
SET HASDATE=0
SET HASNIMG=0
SET HASPRIO=0
SET HASLOCK=0
+3 SET LISTYPE=$PIECE($GET(^MAG(2006.631,LSTID,0)),U,3)
+4 ; columns/hdrs: Order in T array by the Relative Column Order
+5 FOR
SET SS=$ORDER(^MAG(2006.631,LSTID,1,SS))
Begin DoDot:1
+6 IF 'SS
Begin DoDot:2
+7 ; Force CASE#
IF 'HASCASE
SET X=1
DO BLDDEF2(X)
+8 ; DATE/TIME
IF 'HASDATE
SET X=7
DO BLDDEF2(X)
+9 ; NUMBER IMAGES
IF 'HASNIMG
SET X=9
DO BLDDEF2(X)
+10 ; force below only if for an Unread list
if LISTYPE'="U"
QUIT
+11 ; EXAM LOCK IND.
IF 'HASLOCK
SET X=2
DO BLDDEF2(X)
+12 ; PRIORITY
IF 'HASPRIO
SET X=5
DO BLDDEF2(X)
End DoDot:2
QUIT
+13 IF '$TEST
SET X=^MAG(2006.631,LSTID,1,SS,0)
+14 DO BLDDEF2(X)
End DoDot:1
if 'SS
QUIT
+15 ; go thru T to build ordered field sequence for output columns
+16 SET QX="T"
SET STR=""
SET LSTHDR=""
+17 FOR
SET QX=$QUERY(@QX)
if QX=""
QUIT
SET X=@QX
Begin DoDot:1
+18 SET STR=STR_$SELECT(STR="":"",1:U)_$PIECE(X,U)
+19 SET LSTHDR=LSTHDR_$SELECT(LSTHDR="":"",1:U)_$PIECE(X,U,2)
End DoDot:1
+20 SET ^MAG(2006.631,LSTID,"DEF",.5)=LSTHDR
SET ^(1)=STR
+21 ; Sort values:
+22 SET SS=0
SET STR=""
+23 FOR
SET SS=$ORDER(^MAG(2006.631,LSTID,2,SS))
if 'SS
QUIT
SET X=^(SS,0)
Begin DoDot:1
+24 SET X=+X_$SELECT($PIECE(X,U,2):"-",1:"")
+25 SET STR=STR_$SELECT(STR="":"",1:U)_X
End DoDot:1
+26 SET ^MAG(2006.631,LSTID,"DEF",2)=STR
+27 SET $PIECE(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT()
+28 QUIT
+29 ;
BLDDEF2(X) ;
+1 SET X=+X_$SELECT($PIECE(X,U,2):";"_+$PIECE(X,U,2),1:"")
+2 IF 'HASCASE
SET HASCASE=(+X=1)
+3 IF 'HASDATE
SET HASDATE=(+X=7)
+4 IF 'HASNIMG
SET HASNIMG=(+X=9)
+5 IF 'HASLOCK
SET HASLOCK=(+X=2)
+6 IF 'HASPRIO
SET HASPRIO=(+X=5)
+7 SET T0=^MAG(2006.63,+X,0)
SET T6=+$PIECE(T0,U,6)
if 'T6
SET T6=99
+8 SET T8=$PIECE(T0,U,8)
IF T8]""
SET T8="~"_T8
+9 SET XT=$SELECT($PIECE(T0,U,3)]"":$PIECE(T0,U,3),1:$PIECE(T0,U,2))_T8
+10 SET $PIECE(XT,"~",3)=+X
+11 SET T(T6,+X)=X_U_XT
+12 QUIT
+13 ;
POSTINST ; Patch installation inits, etc.
+1 ; D BLDALL ; update list definitions <*> Use any time fields are added
+2 ; re-start background compile
DO BGCSTRT
+3 ; install message, etc.
DO POST
+4 QUIT
+5 ;
BLDALL ; Create "DEF" nodes, Button labels List Def'ns
+1 ; Updates all lists after s/w update list defs are installed
+2 NEW SS,LSTDAT,LSTNUM,BUTTON,LSTTYP
+3 SET SS=0
+4 FOR
SET SS=$ORDER(^MAG(2006.631,SS))
if 'SS
QUIT
SET LSTDAT=$GET(^(SS,0))
IF LSTDAT]""
Begin DoDot:1
+5 SET LSTNUM=$PIECE(LSTDAT,U,2)
SET BUTTON=$PIECE(LSTDAT,U,7)
SET LSTTYP=$PIECE(LSTDAT,U,3)
+6 ; build DEF nodes for System Lists & any Enabled lists
IF LSTNUM>9900!$PIECE(LSTDAT,U,6)
DO BLDDEF(SS)
+7 ; Create Button Labels if needed
IF BUTTON=""
IF (LSTTYP]"")
Begin DoDot:2
+8 SET BUTTON=$SELECT(LSTTYP="U":"Unread #",LSTTYP="R":"Recent #",LSTTYP="A":"All Active #",LSTTYP="P":"Pending #",1:"List #")_LSTNUM
+9 SET $PIECE(^MAG(2006.631,SS,0),U,7)=BUTTON
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
POST ; Install msg
+1 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+2 QUIT
+3 ;
YN(MSG,DFLT) ; get Yes/No reply
+1 NEW X
IF $GET(DFLT)=""
SET DFLT="N"
+2 WRITE !
+3 SET DFLT=$EXTRACT(DFLT)
SET DFLT=$SELECT(DFLT="N":"NO",1:"YES")
YN1 WRITE !,MSG_" "_DFLT_"// "
+1 READ X:DTIME
if X=""
SET X=DFLT
SET X=$EXTRACT(X)
SET X=$TRANSLATE(X,"ynYN","YNYN")
+2 IF "YN"'[X
WRITE " ??? Enter YES or NO",!
GOTO YN1
+3 QUIT X
+4 ;
LSTINQ ; Inq/Disp list def'n
+1 NEW GREF,MAGIEN
+2 WRITE !!?15,"Display VistARad Exams List Definition",!!
+3 NEW MAGIEN
+4 SET DIC=2006.631
SET DIC(0)="AMEQ"
+5 DO ^DIC
IF Y=-1
KILL DIC,DA,DR
QUIT
+6 KILL DR
SET DA=+Y
SET MAGIEN=DA
+7 SET GREF=$NAME(^MAG(2006.631,MAGIEN,"DEF"))
+8 WRITE !
DO EN^DIQ
+9 READ !,"Enter RETURN to display the Search Logic: ",X:DTIME
WRITE !
+10 DO DISPSRCH(GREF)
+11 GOTO LSTINQ
+12 QUIT
+13 ;
DISPSRCH(GREF) ; GREF holds indirect ref for global holding search logic data
+1 IF $DATA(@GREF@(5,1))
WRITE !,"List Exams where:",!
Begin DoDot:1
+2 FOR I=1:1
if '$DATA(@GREF@(5,I))
QUIT
WRITE !?3,^(I)
End DoDot:1
+3 IF '$TEST
WRITE !?3,"NO Search Logic defined!"
+4 QUIT
+5 ;
VRSIT ;
+1 WRITE @IOF,!!?10,"Enter/Edit VistARad Site Parameters",!!
+2 SET DIC=2006.69
SET DIC(0)="ALMEQ"
+3 IF '$DATA(^MAG(DIC,1))
SET DLAYGO=DIC
+4 DO ^DIC
IF Y=-1
KILL DIC,DA,DR,DIE,DLAYGO
QUIT
+5 SET DIE=2006.69
SET DA=+Y
SET DR=".01:20"
+6 DO ^DIE
+7 KILL DIC,DA,DR,DIE,DLAYGO
+8 NEW PLACE
SET DA=""
+9 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+10 if PLACE
SET DA=PLACE
+11 IF DA
Begin DoDot:1
+12 WRITE !!,"Editing VistARad Timeout for division #",DUZ(2),!
+13 SET DIE=2006.1
SET DR="123"
DO ^DIE
End DoDot:1
+14 KILL DA,DR,DIE
+15 QUIT
+16 ;
+17 ;+++++ OPTION: MAGJ E/E DEFAULT USER PROFILES
+18 ;
+19 ; FileMan ^DIE call to enter/edit IMAGING SITE PARAMETERS File (#2006.1),
+20 ; fields #202: DEFAULT VISTARAD USERPREF RAD and
+21 ; #203: DEFAULT VISTARAD USERPREF NON.
+22 ;
+23 ; These fields point to entries in the MAGJ USER DATA File (#2006.68), and
+24 ; allow the VistARad client to initialize new VistARad users to the settings
+25 ; held by the appropriate default user type ("Radiologist", "Non-rad'ist").
+26 ;
EEPRO ;
+1 ;
+2 ;--- Get IEN of IMAGING SITE PARAMETERS File.
+3 NEW FIELD,SITEPIEN
SET SITEPIEN=+$$IMGSIT^MAGJUTL1(DUZ(2),1)
+4 FOR FIELD=202,203
Begin DoDot:1
+5 ;
+6 ;--- Report field being edited.
+7 NEW PROMPT
SET PROMPT=$SELECT(FIELD=202:"RADIOLOGIST",FIELD=203:"NON-RADIOLOGIST")
+8 WRITE !!,"Editing default "_PROMPT_" profile ...",!
+9 NEW DA,DIE,DR
+10 SET DIE=2006.1
SET DR=FIELD
SET DA=SITEPIEN
DO ^DIE
+11 QUIT
End DoDot:1
+12 QUIT
EEPREF ;
+1 WRITE @IOF,!!?10,"Enter/Edit VistARad Prefetch Logic",!!
+2 NEW MAGIEN
+3 KILL DIC
SET (DIC,DLAYGO)=2006.65
SET DIC(0)="ALMEQ"
+4 DO ^DIC
IF Y=-1
KILL DIC,DIE,DR,DLAYGO
QUIT
+5 SET DIE=2006.65
SET DA=+Y
SET DR="[MAGJ PRIOR EDIT]"
+6 SET MAGIEN=DA
+7 DO ^DIE
IF '$DATA(DA)
GOTO EEPREF
+8 GOTO EEPREF
+9 QUIT
INPREF ; Inquire VRad PreFetch
+1 WRITE @IOF,!!?10,"Inquire VistARad Prefetch Logic",!!
+2 NEW MAGIEN,BY,FR,TO
+3 SET DIC=2006.65
SET DIC(0)="AMEQ"
+4 DO ^DIC
IF Y=-1
KILL DIC
QUIT
+5 SET DA=+Y
SET (FR,TO)=$PIECE(Y,U,2)
SET MAGIEN=DA
SET L=0
+6 SET BY="[MAGJ PRIOR SORT]"
SET DIS(0)="I D0=MAGIEN"
+7 DO EN^DIP
+8 READ !,"Enter RETURN to continue: ",X:DTIME
WRITE !
+9 GOTO INPREF
+10 QUIT
PRPREF ;Print VRad Prefetch
+1 NEW BY
+2 WRITE !!
SET DIC=2006.65
SET L=0
SET BY="[MAGJ PRIOR SORT]"
+3 DO EN1^DIP
+4 READ !,"Enter RETURN to continue: ",X:DTIME
WRITE !
+5 QUIT
+6 ;
BGCSTOP ; Stop Background Compile program
+1 NEW MAGCSTRT,GO,NTRY,RETRY,X
+2 SET MAGCSTRT=0
SET GO=1
+3 SET X=$GET(^MAG(2006.69,1,0))
+4 ; Background compile switch; skip if already false
IF X]""
IF +$PIECE(X,U,8)
Begin DoDot:1
+5 ; save current settings for restore later
SET ^MAG(2006.69,"BGSTOP")=X
+6 SET MAGCSTRT=1
+7 SET $PIECE(X,U,8)=0
+8 ; disable compile
SET ^MAG(2006.69,1,0)=X
+9 WRITE !!,*7,"Wait for Background Compile program to stop;"
+10 WRITE !," this might take up to a few minutes."
+11 SET NTRY=60
+12 ; process maintains lock while running
FOR I=1:1:NTRY
WRITE "."
LOCK +^XTMP("MAGJ2","BKGND2","RUN"):3
IF $TEST
QUIT
+13 IF $TEST
Begin DoDot:2
+14 LOCK -^XTMP("MAGJ2","BKGND2","RUN")
+15 WRITE !!,"Background Compile Stopped"
+16 IF +$GET(MAGJKIDS)
WRITE "; proceeding with install.",!
HANG 2
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET X=$$YN("Background Compile NOT Stopped -- Try again?","Y")
+19 SET RETRY=("Y"[X)
SET GO=0
+20 SET ^MAG(2006.69,1,0)=^MAG(2006.69,"BGSTOP")
KILL ^MAG(2006.69,"BGSTOP")
End DoDot:2
End DoDot:1
+21 IF 'GO
if RETRY
GOTO BGCSTOP
+22 IF 'GO
IF +$GET(MAGJKIDS)
WRITE !!,*7," * * * Exiting out of patch installation * * * ",!
HANG 3
SET XPDQUIT=1
+23 QUIT
BGCSTRT ; re-enable Background Compile
+1 IF $DATA(^MAG(2006.69,"BGSTOP"))
SET X=^("BGSTOP")
WRITE " ... Enabling background compile ."
+2 IF '$TEST
QUIT
+3 SET ^MAG(2006.69,1,0)=X
+4 KILL ^MAG(2006.69,"BGSTOP")
+5 WRITE !!,"Background Compile Enabled.",!
HANG 3
+6 QUIT
+7 ;
END ;
