Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGJMN1

MAGJMN1.m

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