MAGBVAL ;WOIFO/GEK - BP Validate Site Params data array ; [ 12/27/2000 10:49 ]
;;3.0;IMAGING;**214,222**;Mar 19, 2002;Build 45;Aug 23, 2018
;; 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
VAL(MAGRY,MAGARRAY,ALL) ;RPC [MAGQBP VAL]
;Call to Validate some of the IMAGING SITE PARAMETERS values
; before the BP IMAGING SITE PARAMETERS Window is opened.
;
; Parameters :
; MAGARRAY - array of 'Field numbers' and Optionally '^' Value
; if the input array, MAGARRAY, has no value for a field,
; then we validate the current value of the field.
; example: MAGARRAY(1)="100^" Field# = 100 Value= ""
; so we would then get value from DataBase.
; ALL - "1" = Validate ALL fields, returning an array
; of error messages.
; "0" = Stop validating if an error occurs, return
; the error message in (0) node.
; ALL will default to 1, if it is null.
;
; Return Variable
; MAGRY() - Array
; Successful MAGRY(0) = 1^Image Data is Valid.
; UNsuccessful MAGRY(0) = 0^Error desc
; IF ALL then MAGRY(1..N) =0^Error desc of all errors
N MAGGFLD,MAGGDAT,MAGRES,MAGPLC,MAGIENS
N Y,AITEM,CT,MAGERR,DAT1,X
N MAGVAL,MAGVALLB
N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
S ALL=$G(ALL,1)
S MAGPLC=$$DUZ2PLC^MAGBAPIP()
S MAGIENS=MAGPLC_","
S MAGRY(0)="0^Validating the Data Array..."
S MAGERR="",CT=0
; Do we have any data ?
I ($D(MAGARRAY)<10) S MAGRY(0)="0^No input data, Operation CANCELED" Q
; Loop through Input Array
S AITEM="" F S AITEM=$O(MAGARRAY(AITEM)) Q:AITEM="" D I $L(MAGERR) Q:'ALL S CT=CT+1,MAGRY(CT)=MAGERR,MAGERR=""
. S MAGERR=""
. S MAGGFLD=$P(MAGARRAY(AITEM),U,1),MAGGDAT=$P(MAGARRAY(AITEM),U,2,99)
. ; IF MAGGDAT = "" then get current Value.
. I MAGGDAT="" S MAGGDAT=$$GET1^DIQ(2006.1,MAGIENS,MAGGFLD,"I","MAGVAL")
. ; HERE we Validate the Data.
. I MAGGDAT="" Q ;This means no data was input, and the Field has no current Value.
. ;
. S DAT1=MAGGDAT
. I '$$VALID(2006.1,MAGGFLD,.MAGGDAT,.MAGRES) S MAGERR="0^"_MAGRES Q
. I DAT1'=MAGGDAT S MAGARRAY(AITEM)=MAGGFLD_"^"_MAGGDAT
. Q
;
; if there was an Error in data we'll quit now.
; If ALL is true, then MAGRY(1...N) will exist if there were errors.
I $O(MAGRY(0)) S MAGRY(0)="0^Errors were found in data." Q
; If ALL is false, then MAGERR will exist if there was an error.
I $L(MAGERR) S MAGRY(0)=MAGERR Q
;
; If all data is valid we get here.
S MAGRY(0)="1^Data is Valid."
Q
VALID(MAGF,MAGL,MAGD,MAGRES) ;internal call to validate value for field in a FM file.
; Function is boolean. Returns:
; 0 - Invalid
; 1 - Valid
; "" - Error
; Call this function before you set the FDA Array.
; MAGD - sent by reference because it could be Internal or External
; and if it is external and valid, it is changed to Internal.
;
; MAGF : File Number
; MAGL : Field Number
; MAGD : (sent by reference) data value of field
; MAGRES: (sent by reference) Result message
;
N MAGR,MAGMSG,MAGSP,MAGRESA,MAGPT
N MAGLABEL,MAGWIN
S MAGWIN=$$BROKER^XWBLIB ; If not MAGWIN, we can write to screen.
;if a BAD field number, Quit
I '$$VFIELD^DILFD(MAGF,MAGL) D Q 0
. S MAGRES="The field number: "_MAGL_", in File: "_MAGF_", is invalid."
;
D FIELD^DID(MAGF,MAGL,"","SPECIFIER;LABEL","MAGSP")
S MAGLABEL=MAGSP("LABEL")
; If it is a pointer field then:
; If an integer - We assume it is an IEN of Pointed to file. Validate that and Quit.
; If not integer - We assume it is external value, proceed to let CHK do validate
I (MAGSP("SPECIFIER")["P"),(+MAGD=MAGD) D Q MAGPT
. I $$EXTERNAL^DILFD(MAGF,MAGL,"",MAGD)'="" S MAGPT=1,MAGRES="Valid pointer" Q
. S MAGPT=0,MAGRES="The value '"_MAGD_"' for field: "_MAGLABEL_" is an invalid Pointer. "
. I 'MAGWIN W !,MAGF,!,MAGL
. ; we are only deleting the Default User Pref if it is bad.
. I (MAGL=100)&(MAGF=2006.1)&('$D(NODEL)) D DEL(MAGF,MAGL,.MAGRES)
. Q
; here, so check external value.
D CHK^DIE(MAGF,MAGL,"E",MAGD,.MAGR,"MAGMSG")
; If success, Quit. We changed External to Internal. Internal is in MAGR
I MAGR'="^" S MAGD=MAGR Q 1
; If not success Get the error text and Quit 0
D MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
S MAGRES=MAGRESA(1)
Q 0
DEL(MAGF,MAGL,MAGRES) ;internal call to delete value of field
I 'MAGWIN W !,"IN DEL File: ",MAGF," Field: ",MAGL
N MAGGMSG,MAGIENS
S X=$$DUZ2PLC^MAGBAPIP()
S MAGIENS=X_","
; For Default User Preference #100
; in Imaging site Parameters #2006.1
; we will delete the current value if it is invalid.
K MAGGFDA,MAGGMSG
S MAGGFDA(MAGF,MAGIENS,MAGL)="@"
D FILE^DIE("S","MAGGFDA","MAGGMSG")
I $D(MAGGMSG)=0 S MAGRES=MAGRES_" the value was Deleted."
;I $D(MAGGMSG)=10 S MAGRES=$G(MAGGMSG("DIERR",1,"TEXT",1))
I $D(MAGGMSG)=10 S MAGRES=MAGRES_" the attempt to Delete, Failed."
Q
ERR ;
N ERR
S ERR=$$EC^%ZOSV
S MAGRY(0)="0^Error during data validation: "_ERR
D @^%ZOSF("ERRTN")
D CLEAN^DILF
Q
;
SETVAL(MAGRY,MAGFILE,MAGDATA) ;RPC [MAGQBP SETVAL] P222 Modify entries in MAGFILE.
; as of patch 223, this is used to set a modified value into the
; DEFAULT USER PREFERENCE field of IMAGING SITE PARAMS file.
; It can be modified in the future to Modify entries in any Imaging File.
; NOTE: Data is not validated. we must validate before we call UPDATE
; ========================
; MAGFILE : two ^ pieces.
; Piece 1 is File Number
; Piece 2 is IEN
; example "2006.1^1"
; MAGDATA : is an array of Field^Value
; example
; MAGDATA(1)="100^135" <<< Field = 100 value = 135
;
S ^GEK("SETVAL","MAGFILE")=MAGFILE
S I="" F S I=$O(MAGDATA(I)) Q:'I S ^GEK("SETVAL","MAGDATA",I)=MAGDATA(I)
N MAGGFDA,MFILE,MIEN,ITEM,MAGERR,FLD,VAL,MAGXERR,MAGXIEN,MAGERR,DATA,NODEL
N MAGWIN S MAGWIN=$$BROKER^XWBLIB
N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
S MFILE=$P(MAGFILE,"^",1)
S MIEN=$P(MAGFILE,"^",2)
I (MFILE="2006.1")&(MIEN="") S MIEN=$$DUZ2PLC^MAGBAPIP()
S MIEN=MIEN_","
S MAGERR=0
S ITEM="" F S ITEM=$O(MAGDATA(ITEM)) Q:ITEM="" D Q:MAGERR
. I 'MAGWIN W !,"ITEM ",ITEM
. S DATA=MAGDATA(ITEM)
. S FLD=$P(DATA,"^",1)
. S VAL=$P(DATA,"^",2)
. S NODEL=1
. I '$$VALID(MFILE,FLD,.VAL,.RES) D Q
. . I 'MAGWIN W !,"VALID FAILED"
. . S MAGERR=1
. . S MAGRY(0)="0^"_RES
. I 'MAGWIN W !,"VAL ",VAL
. S MAGGFDA(MFILE,MIEN,FLD)=VAL
. Q
I 'MAGWIN W !,"MAGERR ",MAGERR
I MAGERR Q
D UPDATE^DIE("S","MAGGFDA","MAGXIEN","MAGXERR")
I $D(DIERR) D RTRNERR(.MAGRY) Q
S MAGRY(0)="1^Success"
D CLEAN^DILF
Q
RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
;ZW MAGXERR
S ETXT="0^ERROR "_MAGXERR("DIERR",1,"TEXT",1)
I 'MAGWIN W !,"RTRNERR: ",ETXT
Q
GETVAL(MAGRY,MFILE,MIEN,MFLDS) ;RPC [MAGQBP GETVAL] P222 USE GETS^DIQ TO GET FIELD VALUES.
; get values from File using GETS^DIQ
; =========================
; MFILE is the FM File number example "2006.1"
; MIEN is the IEN for the file entry example "2"
; MFLDS is a ';' delimited string of Field Numbers. example "100;127;52;.01;.02;.03"
;
; MAGRY is the result array. MAGRY(0) is '1^Success' or '0^error message'
; each entry of array is a 3 "^" delimited string of Field Number^Internal Value^External Value
; example
; MAGRY(0)="1^Success"
; MAGRY(1)=".01^589^KANSAS CITY, MO"
; MAGRY(2)=".02^GB^GB"
; MAGRY(3)=".03^66^MAG1HKAN"
; MAGRY(4)="52^^"
; MAGRY(5)="100^1^FRANK,STUART (SETTING 1)"
; MAGRY(6)="127^^"
;
N MAGWIN,I,CT,Y,MAGOUT,MAGXERR,FLAGS
N N0
K MAGRY,MAGOUT,MAGERR
N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
I (MFILE="2006.1")&(MIEN="") S MIEN=$$DUZ2PLC^MAGBAPIP()
S MIEN=MIEN_","
S MAGWIN=$$BROKER^XWBLIB
I 'MAGWIN W !,"FILE: ",MFILE," IEN: ",MIEN," FLDS: ",MFLDS," FLAGS: ",$G(FLAGS)
S I=0,CT=0
S FLAGS="IE"
I 'MAGWIN W !,"MIEN: ",MIEN
D GETS^DIQ(MFILE,MIEN,MFLDS,FLAGS,"MAGOUT","MAGXERR")
I $D(MAGXERR) D RTRNERR(Y) S MAGRY(0)=Y Q
S MAGRY(0)="1^Success"
S CT=0
S I="" F S I=$O(MAGOUT(MFILE,MIEN,I)) Q:I="" D ;
. S CT=CT+1
. S MAGRY(CT)=I_"^"_MAGOUT(MFILE,MIEN,I,"I")_"^"_MAGOUT(MFILE,MIEN,I,"E")
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGBVAL 9304 printed Oct 16, 2024@18:00:23 Page 2
MAGBVAL ;WOIFO/GEK - BP Validate Site Params data array ; [ 12/27/2000 10:49 ]
+1 ;;3.0;IMAGING;**214,222**;Mar 19, 2002;Build 45;Aug 23, 2018
+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
VAL(MAGRY,MAGARRAY,ALL) ;RPC [MAGQBP VAL]
+1 ;Call to Validate some of the IMAGING SITE PARAMETERS values
+2 ; before the BP IMAGING SITE PARAMETERS Window is opened.
+3 ;
+4 ; Parameters :
+5 ; MAGARRAY - array of 'Field numbers' and Optionally '^' Value
+6 ; if the input array, MAGARRAY, has no value for a field,
+7 ; then we validate the current value of the field.
+8 ; example: MAGARRAY(1)="100^" Field# = 100 Value= ""
+9 ; so we would then get value from DataBase.
+10 ; ALL - "1" = Validate ALL fields, returning an array
+11 ; of error messages.
+12 ; "0" = Stop validating if an error occurs, return
+13 ; the error message in (0) node.
+14 ; ALL will default to 1, if it is null.
+15 ;
+16 ; Return Variable
+17 ; MAGRY() - Array
+18 ; Successful MAGRY(0) = 1^Image Data is Valid.
+19 ; UNsuccessful MAGRY(0) = 0^Error desc
+20 ; IF ALL then MAGRY(1..N) =0^Error desc of all errors
+21 NEW MAGGFLD,MAGGDAT,MAGRES,MAGPLC,MAGIENS
+22 NEW Y,AITEM,CT,MAGERR,DAT1,X
+23 NEW MAGVAL,MAGVALLB
+24 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^"_$TEXT(+0)
+25 SET ALL=$GET(ALL,1)
+26 SET MAGPLC=$$DUZ2PLC^MAGBAPIP()
+27 SET MAGIENS=MAGPLC_","
+28 SET MAGRY(0)="0^Validating the Data Array..."
+29 SET MAGERR=""
SET CT=0
+30 ; Do we have any data ?
+31 IF ($DATA(MAGARRAY)<10)
SET MAGRY(0)="0^No input data, Operation CANCELED"
QUIT
+32 ; Loop through Input Array
+33 SET AITEM=""
FOR
SET AITEM=$ORDER(MAGARRAY(AITEM))
if AITEM=""
QUIT
Begin DoDot:1
+34 SET MAGERR=""
+35 SET MAGGFLD=$PIECE(MAGARRAY(AITEM),U,1)
SET MAGGDAT=$PIECE(MAGARRAY(AITEM),U,2,99)
+36 ; IF MAGGDAT = "" then get current Value.
+37 IF MAGGDAT=""
SET MAGGDAT=$$GET1^DIQ(2006.1,MAGIENS,MAGGFLD,"I","MAGVAL")
+38 ; HERE we Validate the Data.
+39 ;This means no data was input, and the Field has no current Value.
IF MAGGDAT=""
QUIT
+40 ;
+41 SET DAT1=MAGGDAT
+42 IF '$$VALID(2006.1,MAGGFLD,.MAGGDAT,.MAGRES)
SET MAGERR="0^"_MAGRES
QUIT
+43 IF DAT1'=MAGGDAT
SET MAGARRAY(AITEM)=MAGGFLD_"^"_MAGGDAT
+44 QUIT
End DoDot:1
IF $LENGTH(MAGERR)
if 'ALL
QUIT
SET CT=CT+1
SET MAGRY(CT)=MAGERR
SET MAGERR=""
+45 ;
+46 ; if there was an Error in data we'll quit now.
+47 ; If ALL is true, then MAGRY(1...N) will exist if there were errors.
+48 IF $ORDER(MAGRY(0))
SET MAGRY(0)="0^Errors were found in data."
QUIT
+49 ; If ALL is false, then MAGERR will exist if there was an error.
+50 IF $LENGTH(MAGERR)
SET MAGRY(0)=MAGERR
QUIT
+51 ;
+52 ; If all data is valid we get here.
+53 SET MAGRY(0)="1^Data is Valid."
+54 QUIT
VALID(MAGF,MAGL,MAGD,MAGRES) ;internal call to validate value for field in a FM file.
+1 ; Function is boolean. Returns:
+2 ; 0 - Invalid
+3 ; 1 - Valid
+4 ; "" - Error
+5 ; Call this function before you set the FDA Array.
+6 ; MAGD - sent by reference because it could be Internal or External
+7 ; and if it is external and valid, it is changed to Internal.
+8 ;
+9 ; MAGF : File Number
+10 ; MAGL : Field Number
+11 ; MAGD : (sent by reference) data value of field
+12 ; MAGRES: (sent by reference) Result message
+13 ;
+14 NEW MAGR,MAGMSG,MAGSP,MAGRESA,MAGPT
+15 NEW MAGLABEL,MAGWIN
+16 ; If not MAGWIN, we can write to screen.
SET MAGWIN=$$BROKER^XWBLIB
+17 ;if a BAD field number, Quit
+18 IF '$$VFIELD^DILFD(MAGF,MAGL)
Begin DoDot:1
+19 SET MAGRES="The field number: "_MAGL_", in File: "_MAGF_", is invalid."
End DoDot:1
QUIT 0
+20 ;
+21 DO FIELD^DID(MAGF,MAGL,"","SPECIFIER;LABEL","MAGSP")
+22 SET MAGLABEL=MAGSP("LABEL")
+23 ; If it is a pointer field then:
+24 ; If an integer - We assume it is an IEN of Pointed to file. Validate that and Quit.
+25 ; If not integer - We assume it is external value, proceed to let CHK do validate
+26 IF (MAGSP("SPECIFIER")["P")
IF (+MAGD=MAGD)
Begin DoDot:1
+27 IF $$EXTERNAL^DILFD(MAGF,MAGL,"",MAGD)'=""
SET MAGPT=1
SET MAGRES="Valid pointer"
QUIT
+28 SET MAGPT=0
SET MAGRES="The value '"_MAGD_"' for field: "_MAGLABEL_" is an invalid Pointer. "
+29 IF 'MAGWIN
WRITE !,MAGF,!,MAGL
+30 ; we are only deleting the Default User Pref if it is bad.
+31 IF (MAGL=100)&(MAGF=2006.1)&('$DATA(NODEL))
DO DEL(MAGF,MAGL,.MAGRES)
+32 QUIT
End DoDot:1
QUIT MAGPT
+33 ; here, so check external value.
+34 DO CHK^DIE(MAGF,MAGL,"E",MAGD,.MAGR,"MAGMSG")
+35 ; If success, Quit. We changed External to Internal. Internal is in MAGR
+36 IF MAGR'="^"
SET MAGD=MAGR
QUIT 1
+37 ; If not success Get the error text and Quit 0
+38 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
+39 SET MAGRES=MAGRESA(1)
+40 QUIT 0
DEL(MAGF,MAGL,MAGRES) ;internal call to delete value of field
+1 IF 'MAGWIN
WRITE !,"IN DEL File: ",MAGF," Field: ",MAGL
+2 NEW MAGGMSG,MAGIENS
+3 SET X=$$DUZ2PLC^MAGBAPIP()
+4 SET MAGIENS=X_","
+5 ; For Default User Preference #100
+6 ; in Imaging site Parameters #2006.1
+7 ; we will delete the current value if it is invalid.
+8 KILL MAGGFDA,MAGGMSG
+9 SET MAGGFDA(MAGF,MAGIENS,MAGL)="@"
+10 DO FILE^DIE("S","MAGGFDA","MAGGMSG")
+11 IF $DATA(MAGGMSG)=0
SET MAGRES=MAGRES_" the value was Deleted."
+12 ;I $D(MAGGMSG)=10 S MAGRES=$G(MAGGMSG("DIERR",1,"TEXT",1))
+13 IF $DATA(MAGGMSG)=10
SET MAGRES=MAGRES_" the attempt to Delete, Failed."
+14 QUIT
ERR ;
+1 NEW ERR
+2 SET ERR=$$EC^%ZOSV
+3 SET MAGRY(0)="0^Error during data validation: "_ERR
+4 DO @^%ZOSF("ERRTN")
+5 DO CLEAN^DILF
+6 QUIT
+7 ;
SETVAL(MAGRY,MAGFILE,MAGDATA) ;RPC [MAGQBP SETVAL] P222 Modify entries in MAGFILE.
+1 ; as of patch 223, this is used to set a modified value into the
+2 ; DEFAULT USER PREFERENCE field of IMAGING SITE PARAMS file.
+3 ; It can be modified in the future to Modify entries in any Imaging File.
+4 ; NOTE: Data is not validated. we must validate before we call UPDATE
+5 ; ========================
+6 ; MAGFILE : two ^ pieces.
+7 ; Piece 1 is File Number
+8 ; Piece 2 is IEN
+9 ; example "2006.1^1"
+10 ; MAGDATA : is an array of Field^Value
+11 ; example
+12 ; MAGDATA(1)="100^135" <<< Field = 100 value = 135
+13 ;
+14 SET ^GEK("SETVAL","MAGFILE")=MAGFILE
+15 SET I=""
FOR
SET I=$ORDER(MAGDATA(I))
if 'I
QUIT
SET ^GEK("SETVAL","MAGDATA",I)=MAGDATA(I)
+16 NEW MAGGFDA,MFILE,MIEN,ITEM,MAGERR,FLD,VAL,MAGXERR,MAGXIEN,MAGERR,DATA,NODEL
+17 NEW MAGWIN
SET MAGWIN=$$BROKER^XWBLIB
+18 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^"_$TEXT(+0)
+19 SET MFILE=$PIECE(MAGFILE,"^",1)
+20 SET MIEN=$PIECE(MAGFILE,"^",2)
+21 IF (MFILE="2006.1")&(MIEN="")
SET MIEN=$$DUZ2PLC^MAGBAPIP()
+22 SET MIEN=MIEN_","
+23 SET MAGERR=0
+24 SET ITEM=""
FOR
SET ITEM=$ORDER(MAGDATA(ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+25 IF 'MAGWIN
WRITE !,"ITEM ",ITEM
+26 SET DATA=MAGDATA(ITEM)
+27 SET FLD=$PIECE(DATA,"^",1)
+28 SET VAL=$PIECE(DATA,"^",2)
+29 SET NODEL=1
+30 IF '$$VALID(MFILE,FLD,.VAL,.RES)
Begin DoDot:2
+31 IF 'MAGWIN
WRITE !,"VALID FAILED"
+32 SET MAGERR=1
+33 SET MAGRY(0)="0^"_RES
End DoDot:2
QUIT
+34 IF 'MAGWIN
WRITE !,"VAL ",VAL
+35 SET MAGGFDA(MFILE,MIEN,FLD)=VAL
+36 QUIT
End DoDot:1
if MAGERR
QUIT
+37 IF 'MAGWIN
WRITE !,"MAGERR ",MAGERR
+38 IF MAGERR
QUIT
+39 DO UPDATE^DIE("S","MAGGFDA","MAGXIEN","MAGXERR")
+40 IF $DATA(DIERR)
DO RTRNERR(.MAGRY)
QUIT
+41 SET MAGRY(0)="1^Success"
+42 DO CLEAN^DILF
+43 QUIT
RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
+1 ;ZW MAGXERR
+2 SET ETXT="0^ERROR "_MAGXERR("DIERR",1,"TEXT",1)
+3 IF 'MAGWIN
WRITE !,"RTRNERR: ",ETXT
+4 QUIT
GETVAL(MAGRY,MFILE,MIEN,MFLDS) ;RPC [MAGQBP GETVAL] P222 USE GETS^DIQ TO GET FIELD VALUES.
+1 ; get values from File using GETS^DIQ
+2 ; =========================
+3 ; MFILE is the FM File number example "2006.1"
+4 ; MIEN is the IEN for the file entry example "2"
+5 ; MFLDS is a ';' delimited string of Field Numbers. example "100;127;52;.01;.02;.03"
+6 ;
+7 ; MAGRY is the result array. MAGRY(0) is '1^Success' or '0^error message'
+8 ; each entry of array is a 3 "^" delimited string of Field Number^Internal Value^External Value
+9 ; example
+10 ; MAGRY(0)="1^Success"
+11 ; MAGRY(1)=".01^589^KANSAS CITY, MO"
+12 ; MAGRY(2)=".02^GB^GB"
+13 ; MAGRY(3)=".03^66^MAG1HKAN"
+14 ; MAGRY(4)="52^^"
+15 ; MAGRY(5)="100^1^FRANK,STUART (SETTING 1)"
+16 ; MAGRY(6)="127^^"
+17 ;
+18 NEW MAGWIN,I,CT,Y,MAGOUT,MAGXERR,FLAGS
+19 NEW N0
+20 KILL MAGRY,MAGOUT,MAGERR
+21 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^"_$TEXT(+0)
+22 IF (MFILE="2006.1")&(MIEN="")
SET MIEN=$$DUZ2PLC^MAGBAPIP()
+23 SET MIEN=MIEN_","
+24 SET MAGWIN=$$BROKER^XWBLIB
+25 IF 'MAGWIN
WRITE !,"FILE: ",MFILE," IEN: ",MIEN," FLDS: ",MFLDS," FLAGS: ",$GET(FLAGS)
+26 SET I=0
SET CT=0
+27 SET FLAGS="IE"
+28 IF 'MAGWIN
WRITE !,"MIEN: ",MIEN
+29 DO GETS^DIQ(MFILE,MIEN,MFLDS,FLAGS,"MAGOUT","MAGXERR")
+30 IF $DATA(MAGXERR)
DO RTRNERR(Y)
SET MAGRY(0)=Y
QUIT
+31 SET MAGRY(0)="1^Success"
+32 SET CT=0
+33 ;
SET I=""
FOR
SET I=$ORDER(MAGOUT(MFILE,MIEN,I))
if I=""
QUIT
Begin DoDot:1
+34 SET CT=CT+1
+35 SET MAGRY(CT)=I_"^"_MAGOUT(MFILE,MIEN,I,"I")_"^"_MAGOUT(MFILE,MIEN,I,"E")
+36 QUIT
End DoDot:1
+37 QUIT
