MAGGTUP.m

MAGGTUP ;WOIFO/GEK/SG/NST/JSL - Imaging System User preferences ; 07 Mar 2011 2:14 PM

 ;;3.0;IMAGING;**7,8,48,45,59,93,94,117,122**;Mar 19, 2002;Build 92;Aug 02, 2012

 ;; 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.                     |

 ;; +---------------------------------------------------------------+

 ;;

 Q

GET(MAGRY,CODE) ;RPC [MAGGUPREFGET] Call to Get user preferences.

 ;

 N Y,PRFIEN,J,X,Z,NODE,MAGPREF

 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"

 K MAGRY

 S MAGRY(0)="0^Error: Attempting to access user preference"

 S PRFIEN=$O(^MAG(2006.18,"AC",DUZ,""))

 ;    if first time user

 I 'PRFIEN S PRFIEN=$$NEWUSER(DUZ) Q:PRFIEN=-1

 ;    merge default settings into User's Preferences

 D MERGE(PRFIEN)

 ;    This returns the users default Filter, and creates filters if needed.

 S $P(^MAG(2006.18,PRFIEN,"LISTWIN1"),"^",3)=$$DFTFLT^MAGGSFLT(DUZ)

 S MAGRY(0)="1^User Preferences returned."

 ; 

 ; At This point.  Then entry in 2006.18 for User DUZ in complete

 ;   it has been merged with defaults, and has a valid Default Filter.

 ;   

 ;  if caller only wants one node, get it then quit.

 I $L($G(CODE))  S MAGRY($O(MAGRY(""),-1)+1)=CODE_"^"_$G(^MAG(2006.18,PRFIEN,CODE)) Q

 ;

 ;  loop through User Pref file, returning all nodes.

 ; Next line was Un-Commented out. BUT Clients before Patch 8 need it.

 S MAGRY($O(MAGRY(""),-1)+1)="SYS^"_^MAG(2006.18,PRFIEN,0)

 S NODE=""

 F  S NODE=$O(^MAG(2006.18,PRFIEN,NODE)) Q:(NODE="")  D

 . S MAGRY($O(MAGRY(""),-1)+1)=NODE_"^"_^MAG(2006.18,PRFIEN,NODE)

 Q

MERGE(PRFIEN) ; Merge default settings into User Prefs returned.

 ; This will assure the User Prefs returned have values for New fields.

 ; PRFIEN = IEN in IMAGING USER PREFERENCES File.

 N NODE,DARR,MN,YN

 D DFLTARR(.DARR)

 S NODE="" F  S NODE=$O(DARR($J,NODE)) Q:(NODE="")  D

 . S YN=DARR($J,NODE)

 . S MN=$G(^MAG(2006.18,PRFIEN,NODE))

 . F J=1:1:$L(YN,"^") I ($P(YN,"^",J)'=""),($P(MN,"^",J)="") S $P(MN,"^",J)=$P(YN,"^",J)

 . S ^MAG(2006.18,PRFIEN,NODE)=MN

 ;

 Q

SAVE(MAGRY,DATA) ;RPC [MAGGUPREFSAVE] Call to save User Preferences

 ;

 S MAGRY="0^Error: Saving user preferences."

 N X,Y,NODE,PRFIEN,J

 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"

 S PRFIEN=$O(^MAG(2006.18,"AC",DUZ,"")) I 'PRFIEN S PRFIEN=$$NEWUSER(DUZ) Q:PRFIEN=-1

 S NODE="" F  S NODE=$O(DATA(NODE)) Q:NODE=""  D

 . S X=$G(^MAG(2006.18,PRFIEN,NODE))

 . S Y=DATA(NODE)

 . F J=1:1:$L(Y,"^") I $L($P(Y,"^",J)) S $P(X,"^",J)=$P(Y,"^",J)

 . S ^MAG(2006.18,PRFIEN,NODE)=X

 S MAGRY="1^User Preferences saved."

 Q

NEWUSER(USER) ;Returns IEN of New entry in IMAGING USER PREFERENCES File.

 K DD,DO

 N DIC

 S X=$E($$GET1^DIQ(200,USER_",",.01),1,15)_" (SETTING 1)"

 S DIC="^MAG(2006.18,",DIC(0)="L"

 S DIC("DR")="1////"_USER_";2////12;3////12;" D FILE^DICN

 I Y=-1 Q Y

 D DEFAULT(+Y)

 Q +Y

DEFAULT(NEWPREF) ;Setup a new IMAGING USER PREFERENCES entry, with System defaults.

 ;    NEWPREF = IEN in IMAGING USER PREFERENCES File

 N DFTPREF,N0,DFTSET

 S DFTPREF=+$$GET1^DIQ(2006.1,$$PLACE^MAGBAPI(DUZ(2)),100,"I") ; DBI - SEB 9/20/2002

 I DFTPREF,$D(^MAG(2006.18,DFTPREF)) D DEFUSER(NEWPREF,DFTPREF) Q

 ;    save the User name, Setting Name 

 S N0=$P(^MAG(2006.18,NEWPREF,0),U,1,4)

 D DFLTARR(.DFTSET)

 M ^MAG(2006.18,NEWPREF)=DFTSET($J)

 ;    reset User name, Setting name.

 S $P(^MAG(2006.18,NEWPREF,0),U,1,4)=N0

 Q

DEFUSER(NEWPREF,DFTPREF) ;Merge New User preference with the Default User as defined

 ; in the Imaging Site Parameters file

 ;    NEWPREF  =  new IMAGING USER PREFERENCE (IEN)

 ;    DFLTPREF =  DEFAULT USER PREFERENCE in the IMAGING SITE PARAMETERS File

 ; 

 N X0

 S X0=$P(^MAG(2006.18,NEWPREF,0),"^",1,4)

 M ^MAG(2006.18,NEWPREF)=^MAG(2006.18,DFTPREF)

 S $P(^MAG(2006.18,NEWPREF,0),"^",1,4)=X0

 ;    remove default user's default Filter from new user's preferences.

 S $P(^MAG(2006.18,NEWPREF,"LISTWIN1"),"^",3)=""

 Q

DFLTARR(ARR) ; Return an Array of All Default settings

 K ARR($J)

 S ARR($J,0)="^^^^0^1^1^"

 S ARR($J,"DICOMWIN")="2^320^292^724^487"

 S ARR($J,"IMAGEGRID")="2^487^2^786^426^1^35,73,67,34,110,46,69,96,76,79,25,0,0^1^"

 S ARR($J,"REPORT")="2^2^333^722^437^Courier^^10"

 S ARR($J,"RADLISTWIN")="2^487^10^433^172^0"

 S ARR($J,"MAIN")="2^1^1^487^172^1"

 S ARR($J,"ABS")="2^1^160^486^326^134^113^1^1^3^24^2^1^0"

 S ARR($J,"FULL")="2^310^282^714^487^674^447^^1^1^4^1^0^1"

 S ARR($J,"GROUP")="2^24^231^427^457^110^70^^1^2^24^2^1^0"

 S ARR($J,"DOC")="2^298^24^729^429^0^0^3^1^2^4^2^0"

 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"

 ;                    1   2   3   4   5  6  7  8 9 0 1  2   3  456 7 8

 S ARR($J,"CAPTIU")="261^414^455^654^66^67^280^1^1^~^1^100^-12^^^1^1^^"

 S ARR($J,"RIVER")="1^0^0^0^0"

 S ARR($J,"APPMSG")="0^0^"

 S ARR($J,"APPPREFS")="1^7^7^10^^0^0^0^1^0"   ; SET $P 9 =1 for Deleted Image Placeholder default

 S ARR($J,"LISTWIN1")="0^0^^1^0"

 ;--- MAG*3*93

 S ARR($J,"IEDIT")="2^445^295^710^433"

 S ARR($J,"ISTYLE")="0^0^1^1^1^3^1^1^0^1^1^1^,101,460,288,2,2,288,298,259,160,"

 S ARR($J,"IVERIFY")="2^184^56^1201^871^1^0^1^1^44,139,0,0,0,42,0,0,0,0,0,0,0,0,0,58,0,,"

 ;

 ; MAG*3.0*94

 S ARR($J,"EKG")="2^1^1^600^400^0"

 ; MAG*3.0*122

 S ARR($J,"ANNOTCAPTURE")="Arial^0^36^5^32768^159^0^35^35^0^0"

 S ARR($J,"ANNOTDISPLAY")="Arial^0^36^5^32768^159^0^35^35^0^0^1"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGGTUP   6202     printed  Mar 13, 2025@21:08:30                                                                                                                                                                                                     Page 2

MAGGTUP   ;WOIFO/GEK/SG/NST/JSL - Imaging System User preferences ; 07 Mar 2011 2:14 PM

 +1       ;;3.0;IMAGING;**7,8,48,45,59,93,94,117,122**;Mar 19, 2002;Build 92;Aug 02, 2012

 +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      ;;

 +17       QUIT 

GET(MAGRY,CODE) ;RPC [MAGGUPREFGET] Call to Get user preferences.

 +1       ;

 +2        NEW Y,PRFIEN,J,X,Z,NODE,MAGPREF

 +3        NEW $ETRAP,$ESTACK

           SET $ETRAP="D ERRA^MAGGTERR"

 +4        KILL MAGRY

 +5        SET MAGRY(0)="0^Error: Attempting to access user preference"

 +6        SET PRFIEN=$ORDER(^MAG(2006.18,"AC",DUZ,""))

 +7       ;    if first time user

 +8        IF 'PRFIEN

               SET PRFIEN=$$NEWUSER(DUZ)

               if PRFIEN=-1

                   QUIT 

 +9       ;    merge default settings into User's Preferences

 +10       DO MERGE(PRFIEN)

 +11      ;    This returns the users default Filter, and creates filters if needed.

 +12       SET $PIECE(^MAG(2006.18,PRFIEN,"LISTWIN1"),"^",3)=$$DFTFLT^MAGGSFLT(DUZ)

 +13       SET MAGRY(0)="1^User Preferences returned."

 +14      ; 

 +15      ; At This point.  Then entry in 2006.18 for User DUZ in complete

 +16      ;   it has been merged with defaults, and has a valid Default Filter.

 +17      ;   

 +18      ;  if caller only wants one node, get it then quit.

 +19       IF $LENGTH($GET(CODE))

               SET MAGRY($ORDER(MAGRY(""),-1)+1)=CODE_"^"_$GET(^MAG(2006.18,PRFIEN,CODE))

               QUIT 

 +20      ;

 +21      ;  loop through User Pref file, returning all nodes.

 +22      ; Next line was Un-Commented out. BUT Clients before Patch 8 need it.

 +23       SET MAGRY($ORDER(MAGRY(""),-1)+1)="SYS^"_^MAG(2006.18,PRFIEN,0)

 +24       SET NODE=""

 +25       FOR 

               SET NODE=$ORDER(^MAG(2006.18,PRFIEN,NODE))

               if (NODE="")

                   QUIT 

               Begin DoDot:1

 +26               SET MAGRY($ORDER(MAGRY(""),-1)+1)=NODE_"^"_^MAG(2006.18,PRFIEN,NODE)

               End DoDot:1

 +27       QUIT 

MERGE(PRFIEN) ; Merge default settings into User Prefs returned.

 +1       ; This will assure the User Prefs returned have values for New fields.

 +2       ; PRFIEN = IEN in IMAGING USER PREFERENCES File.

 +3        NEW NODE,DARR,MN,YN

 +4        DO DFLTARR(.DARR)

 +5        SET NODE=""

           FOR 

               SET NODE=$ORDER(DARR($JOB,NODE))

               if (NODE="")

                   QUIT 

               Begin DoDot:1

 +6                SET YN=DARR($JOB,NODE)

 +7                SET MN=$GET(^MAG(2006.18,PRFIEN,NODE))

 +8                FOR J=1:1:$LENGTH(YN,"^")

                       IF ($PIECE(YN,"^",J)'="")

                           IF ($PIECE(MN,"^",J)="")

                               SET $PIECE(MN,"^",J)=$PIECE(YN,"^",J)

 +9                SET ^MAG(2006.18,PRFIEN,NODE)=MN

               End DoDot:1

 +10      ;

 +11       QUIT 

SAVE(MAGRY,DATA) ;RPC [MAGGUPREFSAVE] Call to save User Preferences

 +1       ;

 +2        SET MAGRY="0^Error: Saving user preferences."

 +3        NEW X,Y,NODE,PRFIEN,J

 +4        NEW $ETRAP,$ESTACK

           SET $ETRAP="D ERR^MAGGTERR"

 +5        SET PRFIEN=$ORDER(^MAG(2006.18,"AC",DUZ,""))

           IF 'PRFIEN

               SET PRFIEN=$$NEWUSER(DUZ)

               if PRFIEN=-1

                   QUIT 

 +6        SET NODE=""

           FOR 

               SET NODE=$ORDER(DATA(NODE))

               if NODE=""

                   QUIT 

               Begin DoDot:1

 +7                SET X=$GET(^MAG(2006.18,PRFIEN,NODE))

 +8                SET Y=DATA(NODE)

 +9                FOR J=1:1:$LENGTH(Y,"^")

                       IF $LENGTH($PIECE(Y,"^",J))

                           SET $PIECE(X,"^",J)=$PIECE(Y,"^",J)

 +10               SET ^MAG(2006.18,PRFIEN,NODE)=X

               End DoDot:1

 +11       SET MAGRY="1^User Preferences saved."

 +12       QUIT 

NEWUSER(USER) ;Returns IEN of New entry in IMAGING USER PREFERENCES File.

 +1        KILL DD,DO

 +2        NEW DIC

 +3        SET X=$EXTRACT($$GET1^DIQ(200,USER_",",.01),1,15)_" (SETTING 1)"

 +4        SET DIC="^MAG(2006.18,"

           SET DIC(0)="L"

 +5        SET DIC("DR")="1////"_USER_";2////12;3////12;"

           DO FILE^DICN

 +6        IF Y=-1

               QUIT Y

 +7        DO DEFAULT(+Y)

 +8        QUIT +Y

DEFAULT(NEWPREF) ;Setup a new IMAGING USER PREFERENCES entry, with System defaults.

 +1       ;    NEWPREF = IEN in IMAGING USER PREFERENCES File

 +2        NEW DFTPREF,N0,DFTSET

 +3       ; DBI - SEB 9/20/2002

           SET DFTPREF=+$$GET1^DIQ(2006.1,$$PLACE^MAGBAPI(DUZ(2)),100,"I")

 +4        IF DFTPREF

               IF $DATA(^MAG(2006.18,DFTPREF))

                   DO DEFUSER(NEWPREF,DFTPREF)

                   QUIT 

 +5       ;    save the User name, Setting Name 

 +6        SET N0=$PIECE(^MAG(2006.18,NEWPREF,0),U,1,4)

 +7        DO DFLTARR(.DFTSET)

 +8        MERGE ^MAG(2006.18,NEWPREF)=DFTSET($JOB)

 +9       ;    reset User name, Setting name.

 +10       SET $PIECE(^MAG(2006.18,NEWPREF,0),U,1,4)=N0

 +11       QUIT 

DEFUSER(NEWPREF,DFTPREF) ;Merge New User preference with the Default User as defined

 +1       ; in the Imaging Site Parameters file

 +2       ;    NEWPREF  =  new IMAGING USER PREFERENCE (IEN)

 +3       ;    DFLTPREF =  DEFAULT USER PREFERENCE in the IMAGING SITE PARAMETERS File

 +4       ; 

 +5        NEW X0

 +6        SET X0=$PIECE(^MAG(2006.18,NEWPREF,0),"^",1,4)

 +7        MERGE ^MAG(2006.18,NEWPREF)=^MAG(2006.18,DFTPREF)

 +8        SET $PIECE(^MAG(2006.18,NEWPREF,0),"^",1,4)=X0

 +9       ;    remove default user's default Filter from new user's preferences.

 +10       SET $PIECE(^MAG(2006.18,NEWPREF,"LISTWIN1"),"^",3)=""

 +11       QUIT 

DFLTARR(ARR) ; Return an Array of All Default settings

 +1        KILL ARR($JOB)

 +2        SET ARR($JOB,0)="^^^^0^1^1^"

 +3        SET ARR($JOB,"DICOMWIN")="2^320^292^724^487"

 +4        SET ARR($JOB,"IMAGEGRID")="2^487^2^786^426^1^35,73,67,34,110,46,69,96,76,79,25,0,0^1^"

 +5        SET ARR($JOB,"REPORT")="2^2^333^722^437^Courier^^10"

 +6        SET ARR($JOB,"RADLISTWIN")="2^487^10^433^172^0"

 +7        SET ARR($JOB,"MAIN")="2^1^1^487^172^1"

 +8        SET ARR($JOB,"ABS")="2^1^160^486^326^134^113^1^1^3^24^2^1^0"

 +9        SET ARR($JOB,"FULL")="2^310^282^714^487^674^447^^1^1^4^1^0^1"

 +10       SET ARR($JOB,"GROUP")="2^24^231^427^457^110^70^^1^2^24^2^1^0"

 +11       SET ARR($JOB,"DOC")="2^298^24^729^429^0^0^3^1^2^4^2^0"

 +12       SET ARR($JOB,"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"

 +13      ;                    1   2   3   4   5  6  7  8 9 0 1  2   3  456 7 8

 +14       SET ARR($JOB,"CAPTIU")="261^414^455^654^66^67^280^1^1^~^1^100^-12^^^1^1^^"

 +15       SET ARR($JOB,"RIVER")="1^0^0^0^0"

 +16       SET ARR($JOB,"APPMSG")="0^0^"

 +17      ; SET $P 9 =1 for Deleted Image Placeholder default

           SET ARR($JOB,"APPPREFS")="1^7^7^10^^0^0^0^1^0"

 +18       SET ARR($JOB,"LISTWIN1")="0^0^^1^0"

 +19      ;--- MAG*3*93

 +20       SET ARR($JOB,"IEDIT")="2^445^295^710^433"

 +21       SET ARR($JOB,"ISTYLE")="0^0^1^1^1^3^1^1^0^1^1^1^,101,460,288,2,2,288,298,259,160,"

 +22       SET ARR($JOB,"IVERIFY")="2^184^56^1201^871^1^0^1^1^44,139,0,0,0,42,0,0,0,0,0,0,0,0,0,58,0,,"

 +23      ;

 +24      ; MAG*3.0*94

 +25       SET ARR($JOB,"EKG")="2^1^1^600^400^0"

 +26      ; MAG*3.0*122

 +27       SET ARR($JOB,"ANNOTCAPTURE")="Arial^0^36^5^32768^159^0^35^35^0^0"

 +28       SET ARR($JOB,"ANNOTDISPLAY")="Arial^0^36^5^32768^159^0^35^35^0^0^1"

 +29       QUIT