Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTUP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTUP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTUP.m
r613 r623 1 MAGGTUP ;WOIFO/GEK - Imaging System User preferences ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**7,8,48,45,59**;Nov 27, 2007;Build 20 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 GET(MAGRY,CODE) ;RPC [MAGGUPREFGET] Call to Get user preferences. 21 ; 22 N Y,PRFIEN,J,X,Z,NODE,MAGPREF 23 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 24 K MAGRY 25 S MAGRY(0)="0^Error: Attempting to access user preference" 26 S PRFIEN=$O(^MAG(2006.18,"AC",DUZ,"")) 27 ; if first time user 28 I 'PRFIEN S PRFIEN=$$NEWUSER(DUZ) Q:PRFIEN=-1 29 ; merge default settings into User's Preferences 30 D MERGE(PRFIEN) 31 ; This returns the users default Filter, and creates filters if needed. 32 S $P(^MAG(2006.18,PRFIEN,"LISTWIN1"),"^",3)=$$DFTFLT^MAGGSFLT(DUZ) 33 S MAGRY(0)="1^User Preferences returned." 34 ; 35 ; At This point. Then entry in 2006.18 for User DUZ in complete 36 ; it has been merged with defaults, and has a valid Default Filter. 37 ; 38 ; if caller only wants one node, get it then quit. 39 I $L($G(CODE)) S MAGRY($O(MAGRY(""),-1)+1)=CODE_"^"_$G(^MAG(2006.18,PRFIEN,CODE)) Q 40 ; 41 ; loop through User Pref file, returning all nodes. 42 ; Next line was Un-Commented out. BUT Clients before Patch 8 need it. 43 S MAGRY($O(MAGRY(""),-1)+1)="SYS^"_^MAG(2006.18,PRFIEN,0) 44 S NODE="" 45 F S NODE=$O(^MAG(2006.18,PRFIEN,NODE)) Q:(NODE="") D 46 . S MAGRY($O(MAGRY(""),-1)+1)=NODE_"^"_^MAG(2006.18,PRFIEN,NODE) 47 Q 48 MERGE(PRFIEN) ; Merge default settings into User Prefs returned. 49 ; This will assure the User Prefs returned have values for New fields. 50 ; PRFIEN = IEN in IMAGING USER PREFERENCES File. 51 N NODE,DARR,MN,YN 52 D DFLTARR(.DARR) 53 S NODE="" F S NODE=$O(DARR($J,NODE)) Q:(NODE="") D 54 . S YN=DARR($J,NODE) 55 . S MN=$G(^MAG(2006.18,PRFIEN,NODE)) 56 . F J=1:1:$L(YN,"^") I ($P(YN,"^",J)'=""),($P(MN,"^",J)="") S $P(MN,"^",J)=$P(YN,"^",J) 57 . S ^MAG(2006.18,PRFIEN,NODE)=MN 58 ; 59 Q 60 SAVE(MAGRY,DATA) ;RPC [MAGGUPREFSAVE] Call to save User Preferences 61 ; 62 S MAGRY="0^Error: Saving user preferences." 63 N X,Y,NODE,PRFIEN,J 64 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 65 S PRFIEN=$O(^MAG(2006.18,"AC",DUZ,"")) I 'PRFIEN S PRFIEN=$$NEWUSER(DUZ) Q:PRFIEN=-1 66 S NODE="" F S NODE=$O(DATA(NODE)) Q:NODE="" D 67 . S X=$G(^MAG(2006.18,PRFIEN,NODE)) 68 . S Y=DATA(NODE) 69 . F J=1:1:$L(Y,"^") I $L($P(Y,"^",J)) S $P(X,"^",J)=$P(Y,"^",J) 70 . S ^MAG(2006.18,PRFIEN,NODE)=X 71 S MAGRY="1^User Preferences saved." 72 Q 73 NEWUSER(USER) ;Returns IEN of New entry in IMAGING USER PREFERENCES File. 74 K DD,DO 75 N DIC 76 S X=$E($$GET1^DIQ(200,USER_",",.01),1,15)_" (SETTING 1)" 77 S DIC="^MAG(2006.18,",DIC(0)="L" 78 S DIC("DR")="1////"_USER_";2////12;3////12;" D FILE^DICN 79 I Y=-1 Q Y 80 D DEFAULT(+Y) 81 Q +Y 82 DEFAULT(NEWPREF) ;Setup a new IMAGING USER PREFERENCES entry, with System defaults. 83 ; NEWPREF = IEN in IMAGING USER PREFERENCES File 84 N DFTPREF,N0,DFTSET 85 S DFTPREF=+$$GET1^DIQ(2006.1,$$PLACE^MAGBAPI(DUZ(2)),100,"I") ; DBI - SEB 9/20/2002 86 I DFTPREF,$D(^MAG(2006.18,DFTPREF)) D DEFUSER(NEWPREF,DFTPREF) Q 87 ; save the User name, Setting Name 88 S N0=$P(^MAG(2006.18,NEWPREF,0),U,1,4) 89 D DFLTARR(.DFTSET) 90 M ^MAG(2006.18,NEWPREF)=DFTSET($J) 91 ; reset User name, Setting name. 92 S $P(^MAG(2006.18,NEWPREF,0),U,1,4)=N0 93 Q 94 DEFUSER(NEWPREF,DFTPREF) ;Merge New User preference with the Default User as defined 95 ; in the Imaging Site Parameters file 96 ; NEWPREF = new IMAGING USER PREFERENCE (IEN) 97 ; DFLTPREF = DEFAULT USER PREFERENCE in the IMAGING SITE PARAMETERS File 98 ; 99 N X0 100 S X0=$P(^MAG(2006.18,NEWPREF,0),"^",1,4) 101 M ^MAG(2006.18,NEWPREF)=^MAG(2006.18,DFTPREF) 102 S $P(^MAG(2006.18,NEWPREF,0),"^",1,4)=X0 103 ; remove default user's default Filter from new user's preferences. 104 S $P(^MAG(2006.18,NEWPREF,"LISTWIN1"),"^",3)="" 105 Q 106 DFLTARR(ARR) ; Return an Array of All Default settings 107 K ARR($J) 108 S ARR($J,0)="^^^^0^1^1^" 109 S ARR($J,"DICOMWIN")="2^320^292^724^487" 110 S ARR($J,"IMAGEGRID")="2^487^2^786^426^1^35,73,67,34,110,46,69,96,76,79,25,0,0^1^" 111 S ARR($J,"REPORT")="2^2^333^722^437^Courier^^10" 112 S ARR($J,"RADLISTWIN")="2^487^10^433^172^0" 113 S ARR($J,"MAIN")="2^1^1^487^172^1" 114 S ARR($J,"ABS")="2^1^160^486^326^134^113^1^1^3^24^2^1^0" 115 S ARR($J,"FULL")="2^310^282^714^487^674^447^^1^1^4^1^0^1" 116 S ARR($J,"GROUP")="2^24^231^427^457^110^70^^1^2^24^2^1^0" 117 S ARR($J,"DOC")="2^298^24^729^429^0^0^3^1^2^4^2^0" 118 S ARR($J,"CAPCONFIG")="1^1^1^0^0^0^0^1^0^1^0^0^1^1^0^0^1^1^1^1^1^1^200^400^300^100^500^0^0^1^0^1" 119 ; 1 2 3 4 5 6 7 8 9 0 1 2 3 456 7 8 120 S ARR($J,"CAPTIU")="261^414^455^654^66^67^280^1^1^~^1^100^-12^^^1^1^^" 121 S ARR($J,"RIVER")="1^0^0^0^" 122 S ARR($J,"APPMSG")="0^0^" 123 S ARR($J,"APPPREFS")="1^7^7^10" 124 S ARR($J,"LISTWIN1")="1^1^^1^1" 125 Q 1 MAGGTUP ;WOIFO/GEK - Imaging System User preferences ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**7,8,48,45**;Sep 12, 2005 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 ;; | | 11 ;; | The Food and Drug Administration classifies this software as | 12 ;; | a medical device. As such, it may not be changed in any way. | 13 ;; | Modifications to this software may result in an adulterated | 14 ;; | medical device under 21CFR820, the use of which is considered | 15 ;; | to be a violation of US Federal Statutes. | 16 ;; +---------------------------------------------------------------+ 17 ;; 18 Q 19 GET(MAGRY,CODE) ;RPC [MAGGUPREFGET] Call to Get user preferences. 20 ; 21 N Y,PRFIEN,J,X,Z,NODE,MAGPREF 22 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 23 K MAGRY 24 S MAGRY(0)="0^Error: Attempting to access user preference" 25 S PRFIEN=$O(^MAG(2006.18,"AC",DUZ,"")) 26 ; if first time user 27 I 'PRFIEN S PRFIEN=$$NEWUSER(DUZ) Q:PRFIEN=-1 28 ; merge default settings into User's Preferences 29 D MERGE(PRFIEN) 30 ; This returns the users default Filter, and creates filters if needed. 31 S $P(^MAG(2006.18,PRFIEN,"LISTWIN1"),"^",3)=$$DFTFLT^MAGGSFLT(DUZ) 32 S MAGRY(0)="1^User Preferences returned." 33 ; 34 ; At This point. Then entry in 2006.18 for User DUZ in complete 35 ; it has been merged with defaults, and has a valid Default Filter. 36 ; 37 ; if caller only wants one node, get it then quit. 38 I $L($G(CODE)) S MAGRY($O(MAGRY(""),-1)+1)=CODE_"^"_$G(^MAG(2006.18,PRFIEN,CODE)) Q 39 ; 40 ; loop through User Pref file, returning all nodes. 41 ; Next line was Un-Commented out. BUT Clients before Patch 8 need it. 42 S MAGRY($O(MAGRY(""),-1)+1)="SYS^"_^MAG(2006.18,PRFIEN,0) 43 S NODE="" 44 F S NODE=$O(^MAG(2006.18,PRFIEN,NODE)) Q:(NODE="") D 45 . S MAGRY($O(MAGRY(""),-1)+1)=NODE_"^"_^MAG(2006.18,PRFIEN,NODE) 46 Q 47 MERGE(PRFIEN) ; Merge default settings into User Prefs returned. 48 ; This will assure the User Prefs returned have values for New fields. 49 ; PRFIEN = IEN in IMAGING USER PREFERENCES File. 50 N NODE,DARR,MN,YN 51 D DFLTARR(.DARR) 52 S NODE="" F S NODE=$O(DARR($J,NODE)) Q:(NODE="") D 53 . S YN=DARR($J,NODE) 54 . S MN=$G(^MAG(2006.18,PRFIEN,NODE)) 55 . F J=1:1:$L(YN,"^") I ($P(YN,"^",J)'=""),($P(MN,"^",J)="") S $P(MN,"^",J)=$P(YN,"^",J) 56 . S ^MAG(2006.18,PRFIEN,NODE)=MN 57 ; 58 Q 59 SAVE(MAGRY,DATA) ;RPC [MAGGUPREFSAVE] Call to save User Preferences 60 ; 61 S MAGRY="0^Error: Saving user preferences." 62 N X,Y,NODE,PRFIEN,J 63 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 64 S PRFIEN=$O(^MAG(2006.18,"AC",DUZ,"")) I 'PRFIEN S PRFIEN=$$NEWUSER(DUZ) Q:PRFIEN=-1 65 S NODE="" F S NODE=$O(DATA(NODE)) Q:NODE="" D 66 . S X=$G(^MAG(2006.18,PRFIEN,NODE)) 67 . S Y=DATA(NODE) 68 . F J=1:1:$L(Y,"^") I $L($P(Y,"^",J)) S $P(X,"^",J)=$P(Y,"^",J) 69 . S ^MAG(2006.18,PRFIEN,NODE)=X 70 S MAGRY="1^User Preferences saved." 71 Q 72 NEWUSER(USER) ;Returns IEN of New entry in IMAGING USER PREFERENCES File. 73 K DD,DO 74 N DIC 75 S X=$E($$GET1^DIQ(200,USER_",",.01),1,15)_" (SETTING 1)" 76 S DIC="^MAG(2006.18,",DIC(0)="L" 77 S DIC("DR")="1////"_USER_";2////12;3////12;" D FILE^DICN 78 I Y=-1 Q Y 79 D DEFAULT(+Y) 80 Q +Y 81 DEFAULT(NEWPREF) ;Setup a new IMAGING USER PREFERENCES entry, with System defaults. 82 ; NEWPREF = IEN in IMAGING USER PREFERENCES File 83 N DFTPREF,N0,DFTSET 84 S DFTPREF=+$$GET1^DIQ(2006.1,$$PLACE^MAGBAPI(DUZ(2)),100,"I") ; DBI - SEB 9/20/2002 85 I DFTPREF,$D(^MAG(2006.18,DFTPREF)) D DEFUSER(NEWPREF,DFTPREF) Q 86 ; save the User name, Setting Name 87 S N0=$P(^MAG(2006.18,NEWPREF,0),U,1,4) 88 D DFLTARR(.DFTSET) 89 M ^MAG(2006.18,NEWPREF)=DFTSET($J) 90 ; reset User name, Setting name. 91 S $P(^MAG(2006.18,NEWPREF,0),U,1,4)=N0 92 Q 93 DEFUSER(NEWPREF,DFTPREF) ;Merge New User preference with the Default User as defined 94 ; in the Imaging Site Parameters file 95 ; NEWPREF = new IMAGING USER PREFERENCE (IEN) 96 ; DFLTPREF = DEFAULT USER PREFERENCE in the IMAGING SITE PARAMETERS File 97 ; 98 N X0 99 S X0=$P(^MAG(2006.18,NEWPREF,0),"^",1,4) 100 M ^MAG(2006.18,NEWPREF)=^MAG(2006.18,DFTPREF) 101 S $P(^MAG(2006.18,NEWPREF,0),"^",1,4)=X0 102 ; remove default user's default Filter from new user's preferences. 103 S $P(^MAG(2006.18,NEWPREF,"LISTWIN1"),"^",3)="" 104 Q 105 DFLTARR(ARR) ; Return an Array of All Default settings 106 K ARR($J) 107 S ARR($J,0)="^^^^0^1^1^" 108 S ARR($J,"DICOMWIN")="2^320^292^724^487" 109 S ARR($J,"IMAGEGRID")="2^487^2^786^426^1^35,73,67,34,110,46,69,96,76,79,25,0,0^1^" 110 S ARR($J,"REPORT")="2^2^333^722^437^Courier^^10" 111 S ARR($J,"RADLISTWIN")="2^487^10^433^172^0" 112 S ARR($J,"MAIN")="2^1^1^487^172^1" 113 S ARR($J,"ABS")="2^1^160^486^326^134^113^1^1^3^24^2^1^0" 114 S ARR($J,"FULL")="2^310^282^714^487^674^447^^1^1^4^1^0^1" 115 S ARR($J,"GROUP")="2^24^231^427^457^110^70^^1^2^24^2^1^0" 116 S ARR($J,"DOC")="2^298^24^729^429^0^0^3^1^2^4^2^0" 117 S ARR($J,"CAPCONFIG")="1^1^1^0^0^0^0^1^0^1^0^0^1^1^0^0^1^1^1^1^1^1^200^400^300^100^500^0^0^1^" 118 S ARR($J,"CAPTIU")="5^369^760^654^289^67^170^1^1^" 119 S ARR($J,"RIVER")="1^0^0^0^" 120 S ARR($J,"APPPREFS")="1^7^7^10" 121 S ARR($J,"LISTWIN1")="1^1^^1^1" 122 Q
Note:
See TracChangeset
for help on using the changeset viewer.
