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

MAGBVAL.m

Go to the documentation of this file.
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