MAGTP011 ;WOIFO/FG,MLH - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:41 PM
;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; 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 THE USER'S SETTING/PREFERENCES IN XML FORMAT
; FROM THE CONFIGURATION FILE (#2006.13)
; RPC: MAGTP GET PREFERENCES
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; ENT List of inputs:
; ^01: DUZ of user whose preferences are to be retrieved
; ^02: LABEL of preference section
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: Total Number of Lines
; ^03: <DUZ>: <LABEL>
;
; MAGRY(i) Description
; ^01: XML Line of Text
;
GETUPREF(MAGRY,ENT) ; RPC [MAGTP GET PREFERENCES]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
N LDUZ,FILE,FILE2,LABEL,CT,I
N MAGREC0,MAGREC1,MAGREC2,MAGOUT,MAGERR
S FILE=2006.13
S FILE2=2006.1371
;
S LDUZ=$P($G(ENT),U) ; First line of ENT is LDUZ^LABEL
I LDUZ="" S LDUZ=DUZ ; Default to user's DUZ if null
I $$GET1^DIQ(200,LDUZ_",",.01)="" S MAGRY(0)="0^0^Invalid DUZ" Q ; IA #10060
;
; Get configuration record IEN or bail
;
S MAGREC0=$O(^MAG(FILE,0))
I 'MAGREC0 S MAGRY(0)="0^0^No configuration record defined" Q
;
S MAGREC1=$O(^MAG(FILE,MAGREC0,7,"B",LDUZ,""))
I MAGREC1="" S MAGRY(0)="0^0^No preferences found for "_LDUZ Q
;
S LABEL=$P(ENT,U,2)
I LABEL="" S MAGRY(0)="0^0^No Label entered" Q
S MAGREC2=$O(^MAG(FILE,MAGREC0,7,MAGREC1,1,"B",LABEL,""))
I MAGREC2="" D Q
. S MAGRY(0)="0^0^No preferences found for "_LDUZ_": "_LABEL
;
D GET1^DIQ(FILE2,MAGREC2_","_MAGREC1_","_MAGREC0_",",.02,"","MAGOUT","MAGERR")
I $D(MAGERR) D Q
. S MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
S (CT,I)=0
F S I=$O(MAGOUT(I)) Q:I="" D
. S CT=CT+1
. S MAGRY(CT)=MAGOUT(I)
. Q
S MAGRY(0)="1^"_CT_U_LDUZ_": "_LABEL
Q ;
;
;***** SET THE USER'S SETTING/PREFERENCES IN XML FORMAT
; IN THE CONFIGURATION FILE (#2006.13)
; RPC: MAGTP PUT PREFERENCES
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; .ENT Input array:
;
; First Line: DUZ^Label
; Following Lines: One XML line of text
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: 0
; ^03: <DUZ>: <LABEL> " Preferences Updated"
;
PUTUPREF(MAGRY,ENT) ; RPC [MAGTP PUT PREFERENCES]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I $D(ENT)<10 S MAGRY(0)="0^0^No Input" Q
N LINE,LDUZ,FILE,FILE1,FILE2,LABEL
N MAGFDA,MAGERR,ORIEN
N MAGREC0,MAGREC1,MAGREC2,I
S FILE=2006.13
S FILE1=2006.137
S FILE2=2006.1371
;
; Get configuration record IEN or bail
;
S MAGREC0=$O(^MAG(FILE,0))
I 'MAGREC0 S MAGRY(0)="0^0^No configuration record defined" Q
;
S LINE=$O(ENT(""))
S LDUZ=$P(ENT(LINE),U) ; First line of ENT is LDUZ^LABEL
I LDUZ="" S LDUZ=DUZ ; Default to user's DUZ if null
I $$GET1^DIQ(200,LDUZ_",",.01)="" S MAGRY(0)="0^0^Invalid DUZ" Q ; IA #10060
S MAGREC1=$O(^MAG(FILE,MAGREC0,7,"B",LDUZ,""))
;
; If MAGREC1 is not defined add a DUZ record
;
I MAGREC1="" D Q:$P($G(MAGRY(0)),U)=0
. S MAGFDA(1,FILE1,"+1,"_MAGREC0_",",.01)=LDUZ
. D UPDATE^DIE("","MAGFDA(1)","ORIEN","MAGERR")
. I $D(MAGERR) D Q
. . S MAGRY(0)="0^0^Update Error: "_MAGERR("DIERR",1,"TEXT",1)
. S MAGREC1=ORIEN(1) ; MAGREC1 generated
. K ORIEN
. Q
;
S LABEL=$P(ENT(LINE),U,2)
I LABEL="" S MAGRY(0)="0^0^No Label entered" Q
S MAGREC2=$O(^MAG(FILE,MAGREC0,7,MAGREC1,1,"B",LABEL,""))
;
; If MAGREC2 is not defined add a label
;
I MAGREC2="" D Q:$P($G(MAGRY(0)),U)=0
. K MAGFDA,MAGERR
. S MAGFDA(1,FILE2,"+1,"_MAGREC1_","_MAGREC0_",",.01)=LABEL
. D UPDATE^DIE("","MAGFDA(1)","ORIEN","MAGERR")
. I $D(MAGERR) D Q
. . S MAGRY(0)="0^0^Update Error: "_MAGERR("DIERR",1,"TEXT",1)
. S MAGREC2=ORIEN(1) ; MAGREC2 generated
. K ORIEN
. Q
;
; Set new preferences
;
K MAGFDA,MAGERR
S I=0
F S LINE=$O(ENT(LINE)) Q:LINE="" D ; Start from second line
. S I=I+1
. S MAGFDA(I)=ENT(LINE) ; FDA arrays cannot start from 0
. Q
D WP^DIE(FILE2,MAGREC2_","_MAGREC1_","_MAGREC0_",",.02,"K","MAGFDA","MAGERR")
I $D(MAGERR) D Q
. S MAGRY(0)="0^0^Updating Error: "_MAGERR("DIERR",1,"TEXT",1)
S MAGRY(0)="1^0^"_LDUZ_": "_LABEL_" - Preferences Updated"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP011 6106 printed Nov 22, 2024@17:18:50 Page 2
MAGTP011 ;WOIFO/FG,MLH - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:41 PM
+1 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+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
+18 ;
+19 ;***** GET THE USER'S SETTING/PREFERENCES IN XML FORMAT
+20 ; FROM THE CONFIGURATION FILE (#2006.13)
+21 ; RPC: MAGTP GET PREFERENCES
+22 ;
+23 ; .MAGRY Reference to a local variable where the results
+24 ; are returned to.
+25 ;
+26 ; ENT List of inputs:
+27 ; ^01: DUZ of user whose preferences are to be retrieved
+28 ; ^02: LABEL of preference section
+29 ;
+30 ; Return Values
+31 ; =============
+32 ;
+33 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+34 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+35 ;
+36 ; Otherwise, the output array is as follows:
+37 ;
+38 ; MAGRY(0) Description
+39 ; ^01: 1
+40 ; ^02: Total Number of Lines
+41 ; ^03: <DUZ>: <LABEL>
+42 ;
+43 ; MAGRY(i) Description
+44 ; ^01: XML Line of Text
+45 ;
GETUPREF(MAGRY,ENT) ; RPC [MAGTP GET PREFERENCES]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 NEW LDUZ,FILE,FILE2,LABEL,CT,I
+4 NEW MAGREC0,MAGREC1,MAGREC2,MAGOUT,MAGERR
+5 SET FILE=2006.13
+6 SET FILE2=2006.1371
+7 ;
+8 ; First line of ENT is LDUZ^LABEL
SET LDUZ=$PIECE($GET(ENT),U)
+9 ; Default to user's DUZ if null
IF LDUZ=""
SET LDUZ=DUZ
+10 ; IA #10060
IF $$GET1^DIQ(200,LDUZ_",",.01)=""
SET MAGRY(0)="0^0^Invalid DUZ"
QUIT
+11 ;
+12 ; Get configuration record IEN or bail
+13 ;
+14 SET MAGREC0=$ORDER(^MAG(FILE,0))
+15 IF 'MAGREC0
SET MAGRY(0)="0^0^No configuration record defined"
QUIT
+16 ;
+17 SET MAGREC1=$ORDER(^MAG(FILE,MAGREC0,7,"B",LDUZ,""))
+18 IF MAGREC1=""
SET MAGRY(0)="0^0^No preferences found for "_LDUZ
QUIT
+19 ;
+20 SET LABEL=$PIECE(ENT,U,2)
+21 IF LABEL=""
SET MAGRY(0)="0^0^No Label entered"
QUIT
+22 SET MAGREC2=$ORDER(^MAG(FILE,MAGREC0,7,MAGREC1,1,"B",LABEL,""))
+23 IF MAGREC2=""
Begin DoDot:1
+24 SET MAGRY(0)="0^0^No preferences found for "_LDUZ_": "_LABEL
End DoDot:1
QUIT
+25 ;
+26 DO GET1^DIQ(FILE2,MAGREC2_","_MAGREC1_","_MAGREC0_",",.02,"","MAGOUT","MAGERR")
+27 IF $DATA(MAGERR)
Begin DoDot:1
+28 SET MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
End DoDot:1
QUIT
+29 SET (CT,I)=0
+30 FOR
SET I=$ORDER(MAGOUT(I))
if I=""
QUIT
Begin DoDot:1
+31 SET CT=CT+1
+32 SET MAGRY(CT)=MAGOUT(I)
+33 QUIT
End DoDot:1
+34 SET MAGRY(0)="1^"_CT_U_LDUZ_": "_LABEL
+35 ;
QUIT
+36 ;
+37 ;***** SET THE USER'S SETTING/PREFERENCES IN XML FORMAT
+38 ; IN THE CONFIGURATION FILE (#2006.13)
+39 ; RPC: MAGTP PUT PREFERENCES
+40 ;
+41 ; .MAGRY Reference to a local variable where the results
+42 ; are returned to.
+43 ;
+44 ; .ENT Input array:
+45 ;
+46 ; First Line: DUZ^Label
+47 ; Following Lines: One XML line of text
+48 ;
+49 ; Return Values
+50 ; =============
+51 ;
+52 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+53 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+54 ;
+55 ; Otherwise, the output array is as follows:
+56 ;
+57 ; MAGRY(0) Description
+58 ; ^01: 1
+59 ; ^02: 0
+60 ; ^03: <DUZ>: <LABEL> " Preferences Updated"
+61 ;
PUTUPREF(MAGRY,ENT) ; RPC [MAGTP PUT PREFERENCES]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF $DATA(ENT)<10
SET MAGRY(0)="0^0^No Input"
QUIT
+4 NEW LINE,LDUZ,FILE,FILE1,FILE2,LABEL
+5 NEW MAGFDA,MAGERR,ORIEN
+6 NEW MAGREC0,MAGREC1,MAGREC2,I
+7 SET FILE=2006.13
+8 SET FILE1=2006.137
+9 SET FILE2=2006.1371
+10 ;
+11 ; Get configuration record IEN or bail
+12 ;
+13 SET MAGREC0=$ORDER(^MAG(FILE,0))
+14 IF 'MAGREC0
SET MAGRY(0)="0^0^No configuration record defined"
QUIT
+15 ;
+16 SET LINE=$ORDER(ENT(""))
+17 ; First line of ENT is LDUZ^LABEL
SET LDUZ=$PIECE(ENT(LINE),U)
+18 ; Default to user's DUZ if null
IF LDUZ=""
SET LDUZ=DUZ
+19 ; IA #10060
IF $$GET1^DIQ(200,LDUZ_",",.01)=""
SET MAGRY(0)="0^0^Invalid DUZ"
QUIT
+20 SET MAGREC1=$ORDER(^MAG(FILE,MAGREC0,7,"B",LDUZ,""))
+21 ;
+22 ; If MAGREC1 is not defined add a DUZ record
+23 ;
+24 IF MAGREC1=""
Begin DoDot:1
+25 SET MAGFDA(1,FILE1,"+1,"_MAGREC0_",",.01)=LDUZ
+26 DO UPDATE^DIE("","MAGFDA(1)","ORIEN","MAGERR")
+27 IF $DATA(MAGERR)
Begin DoDot:2
+28 SET MAGRY(0)="0^0^Update Error: "_MAGERR("DIERR",1,"TEXT",1)
End DoDot:2
QUIT
+29 ; MAGREC1 generated
SET MAGREC1=ORIEN(1)
+30 KILL ORIEN
+31 QUIT
End DoDot:1
if $PIECE($GET(MAGRY(0)),U)=0
QUIT
+32 ;
+33 SET LABEL=$PIECE(ENT(LINE),U,2)
+34 IF LABEL=""
SET MAGRY(0)="0^0^No Label entered"
QUIT
+35 SET MAGREC2=$ORDER(^MAG(FILE,MAGREC0,7,MAGREC1,1,"B",LABEL,""))
+36 ;
+37 ; If MAGREC2 is not defined add a label
+38 ;
+39 IF MAGREC2=""
Begin DoDot:1
+40 KILL MAGFDA,MAGERR
+41 SET MAGFDA(1,FILE2,"+1,"_MAGREC1_","_MAGREC0_",",.01)=LABEL
+42 DO UPDATE^DIE("","MAGFDA(1)","ORIEN","MAGERR")
+43 IF $DATA(MAGERR)
Begin DoDot:2
+44 SET MAGRY(0)="0^0^Update Error: "_MAGERR("DIERR",1,"TEXT",1)
End DoDot:2
QUIT
+45 ; MAGREC2 generated
SET MAGREC2=ORIEN(1)
+46 KILL ORIEN
+47 QUIT
End DoDot:1
if $PIECE($GET(MAGRY(0)),U)=0
QUIT
+48 ;
+49 ; Set new preferences
+50 ;
+51 KILL MAGFDA,MAGERR
+52 SET I=0
+53 ; Start from second line
FOR
SET LINE=$ORDER(ENT(LINE))
if LINE=""
QUIT
Begin DoDot:1
+54 SET I=I+1
+55 ; FDA arrays cannot start from 0
SET MAGFDA(I)=ENT(LINE)
+56 QUIT
End DoDot:1
+57 DO WP^DIE(FILE2,MAGREC2_","_MAGREC1_","_MAGREC0_",",.02,"K","MAGFDA","MAGERR")
+58 IF $DATA(MAGERR)
Begin DoDot:1
+59 SET MAGRY(0)="0^0^Updating Error: "_MAGERR("DIERR",1,"TEXT",1)
End DoDot:1
QUIT
+60 SET MAGRY(0)="1^0^"_LDUZ_": "_LABEL_" - Preferences Updated"
+61 QUIT
