- 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 Jan 18, 2025@03:08:02 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 ;