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

MAGVAF01.m

Go to the documentation of this file.
  1. MAGVAF01 ;WOIFO/NST/DAC - Utilities for RPC calls ; 28 Feb 2013 9:58 AM
  1. ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. IDF2FM(IDFDT) ; converts date time in format YYYYMMDD.HHMMSS to FileMan format CYYMMDD.HHMMSS
  1. I IDFDT="" Q ""
  1. N MAGTIME
  1. S MAGTIME=$P(IDFDT,".",2)
  1. Q (IDFDT\1-17000000)_"."_MAGTIME
  1. ;
  1. FM2IDF(FMDT) ; converts date time in FileMan format CYYMMDD.HHMMSS to YYYYMMDD.HHMMSS
  1. I FMDT="" Q ""
  1. N MAGTIME
  1. S MAGTIME=$P(FMDT,".",2)
  1. Q (FMDT\1+17000000)_"."_MAGTIME
  1. ;
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE = FileMan file number (e.g. 2006.917)
  1. GETFILNM(FILE) ; Returns file name
  1. Q $$GET1^DID(FILE,"","","NAME")
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE - FileMan file
  1. GETFILGL(FILE) ; Get Global root of the file
  1. Q $$ROOT^DILFD(FILE)
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE - FileMan file
  1. ; FNAME - Field name
  1. GETFLDID(FILE,FNAME) ; Returns a field number
  1. Q $$FLDNUM^DILFD(FILE,FNAME)
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE - FileMan file
  1. ; FLDID - Field Number
  1. GETFLDNM(FILE,FLDID) ; Returns a field name
  1. Q $$GET1^DID(FILE,FLDID,"","LABEL")
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE - FileMan file
  1. ; FLDID - Field Number
  1. ISFLDDT(FILE,FLDID) ; Returns true(1) or false(0) if a field is from DATE/TIME type
  1. Q $$GET1^DID(FILE,FLDID,"","TYPE")="DATE/TIME"
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE - FileMan file
  1. ; FLDID - Field Number
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; TYPEDEF = Type of Word-Processing field
  1. ISFLDWP(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type
  1. N WPFILE
  1. S TYPEDEF=""
  1. Q:$$GET1^DID(FILE,FLDID,"","TYPE")'="WORD-PROCESSING" 0
  1. S WPFILE=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
  1. S TYPEDEF=$$GET1^DID(WPFILE,.01,"","SPECIFIER")
  1. Q 1
  1. ;
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ; FILE - FileMan file
  1. ; FLDID - Field Number
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; TYPEDEF = Type of field
  1. ISFLDSUB(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type or Multiple
  1. N FILESUB
  1. S TYPEDEF=""
  1. Q:'$$GET1^DID(FILE,FLDID,"","MULTIPLE-VALUED") 0
  1. S FILESUB=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
  1. S TYPEDEF=$$GET1^DID(FILESUB,.01,"","SPECIFIER")
  1. Q 1
  1. ;
  1. GETFLDS(MAGRY,MAGRYW,FILE,FLAGS) ; Returns array with all fields in a file
  1. ;
  1. ; Input Parameters
  1. ; ================
  1. ; FILE = FileMan file number
  1. ; FLAGS = I - add I(internal) to the field numbers in Result e.g .01I;2I;3I
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; Result=n1;n2;n3 (e.g. .01;2;3) - no multiple or word-processing fields
  1. ;
  1. ; MAGRY(n)=nth field name
  1. ; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
  1. ;
  1. ; MAGRYW(n)=nth Word-Processing field name
  1. ; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
  1. ;
  1. N I,FLDID,FLDS,DEL
  1. N WPTYPE,IVAL
  1. K MAGRY,MAGRYW
  1. S IVAL=$S($G(FLAGS)["I":"I",1:"")
  1. S I=""
  1. S FLDS=""
  1. F S I=$O(^DD(FILE,"B",I)) Q:I="" D ; IA #5551
  1. . S FLDID=$O(^DD(FILE,"B",I,""))
  1. . I $$ISFLDSUB^MAGVAF01(.WPTYPE,FILE,FLDID) D
  1. . . S MAGRYW(FLDID)=I
  1. . . S MAGRYW(FLDID,"TYPE")=WPTYPE
  1. . . Q
  1. . E D
  1. . . S MAGRY(FLDID)=I
  1. . . S MAGRY(FLDID,"TYPE")=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
  1. . . Q
  1. . Q
  1. S I="",DEL=""
  1. F S I=$O(MAGRY(I)) Q:I="" D
  1. . ; Skip multiple and word-processing fields GETS^DIQ cannot handle Word-Processing field
  1. . I $$ISFLDSUB^MAGVAF01(.WPTYPE,FILE,I) Q
  1. . S FLDS=FLDS_DEL_I_IVAL
  1. . S DEL=";"
  1. . Q
  1. Q FLDS
  1. ;
  1. GETSUBFL(FILE,FIELD) ; Returns sub-file of a multiple field
  1. Q $$GET1^DID(FILE,FIELD,"","SPECIFIER")
  1. ;
  1. VALIDFLD(FILE,FIELD,VALUE,MESSAGE) ; call to validate value for field in a FM file.
  1. ; Function is boolean. Returns:
  1. ; 0 - Invalid
  1. ; 1 - Valid
  1. ; FILE : File Number
  1. ; FIELD : Field Number
  1. ; VALUE : (sent by reference) data value of field
  1. ; MESSAGE (sent by reference) Result message
  1. ;
  1. N MAGR,MAGMSG,MAGSP,MAGRESA,MAGPT
  1. ; Get the Field number
  1. I +FIELD'=FIELD S FIELD=$$GETFLDID^MAGVAF01(FILE,FIELD)
  1. ;if a BAD field number
  1. I '$$VFIELD^DILFD(FILE,FIELD) D Q 0
  1. . S MESSAGE="The field number: "_FIELD_", in File: "_FILE_", is invalid."
  1. D FIELD^DID(FILE,FIELD,"","SPECIFIER","MAGSP")
  1. ; If it is a pointer field
  1. ; If an integer - We assume it is a pointer and validate that and Quit.
  1. ; If not integer - We assume it is external value, proceed to let CHK do validate
  1. I (MAGSP("SPECIFIER")["P"),(+VALUE=VALUE) D Q MAGPT
  1. . I $$EXTERNAL^DILFD(FILE,FIELD,"",VALUE)'="" S MAGPT=1 Q
  1. . S MAGPT=0,MESSAGE="The value: "_VALUE_" for field: "_FIELD_" in File: "_FILE_" is an invalid Pointer."
  1. . Q
  1. ;
  1. D CHK^DIE(FILE,FIELD,"",VALUE,.MAGR,"MAGMSG")
  1. ; If success, Quit. We changed External to Internal. Internal is in MAGR
  1. I MAGR'="^" Q 1
  1. ; If not success Get the error text and Quit 0
  1. D MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
  1. S MESSAGE=MAGRESA(1)
  1. Q 0
  1. ;
  1. ;+++++ Check if all required fields are sent
  1. ;
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ;
  1. ; FILE = file number
  1. ; FLDSVAL = array with fields values. Index of the array is fields names
  1. ; FLDSARR = array with fields definition. Index is field's numbers
  1. ; FLGWP = this is Word-processing fields
  1. ;
  1. ; Result Values
  1. ; =============
  1. ;
  1. ; if failure MAGRY = Failure status ^ Error message
  1. ; if success MAGRY = Success status
  1. ;
  1. REQFLDS(MAGRY,FILE,FLDSVAL,FLDSARR,FLGWP) ;
  1. N FLDNAME,MSG,ERR
  1. N TFLDSARR
  1. N WP
  1. M TFLDSARR=FLDSARR
  1. S FLDNAME=""
  1. S ERR=0
  1. F S FLDNAME=$O(FLDSVAL(FLDNAME)) Q:FLDNAME="" D Q:ERR
  1. . I 'FLGWP Q:FLDSVAL(FLDNAME)="" ; value is empty, so get next one
  1. . I FLGWP M WP=FLDSVAL(FLDNAME) Q:$$WPEMPTY^MAGVAF01(.WP) ; quit if WP field is blank
  1. . S FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
  1. . I FIELD="" D Q
  1. . . S MSG="Field """_FLDNAME_""" is not found in file #"_FILE
  1. . . S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MSG
  1. . . S ERR=1
  1. . . Q
  1. . K TFLDSARR(FIELD) ; delete the field from the list; will use it in the check for check required fields
  1. . Q
  1. I ERR Q
  1. ; Check if we set all required fields
  1. S FIELD=""
  1. F S FIELD=$O(TFLDSARR(FIELD)) Q:FIELD="" D Q:ERR
  1. . I TFLDSARR(FIELD,"TYPE")["R" D Q
  1. . . S MSG="Field """_TFLDSARR(FIELD)_""" is required in file #"_FILE
  1. . . S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MSG
  1. . . S ERR=1
  1. . . Q
  1. . Q
  1. Q:ERR
  1. ;
  1. S MAGRY=$$OK^MAGVAF02()
  1. Q
  1. ;
  1. ; Return WP field value as a string
  1. ; WP = Word-Processing field values
  1. ; e.g. WP(1)=Line 1
  1. ; WP(2)=Line 2
  1. ;
  1. STRWP(WP) ; Return WP field value as a string
  1. N I,RESULT
  1. S I=""
  1. S RESULT=""
  1. F S I=$O(WP(I)) Q:I="" D
  1. . S RESULT=RESULT_WP(I)
  1. . Q
  1. Q RESULT
  1. ;
  1. ; WP field value is blank
  1. ; Return 1 - WP field value is blank
  1. ; 0
  1. ; WP = Word-Processing field values
  1. ; e.g. WP(1)=Line 1
  1. ; WP(2)=Line 2
  1. ;
  1. WPEMPTY(WP) ; Return 1 when WP field value is blank
  1. N I,RESULT
  1. S I=""
  1. S RESULT=1
  1. F S I=$O(WP(I)) Q:I=""!'RESULT D
  1. . S RESULT=$L(WP(I))=0
  1. . Q
  1. Q RESULT
  1. ;
  1. ; Add a new record
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ;
  1. ; FILE - file number
  1. ; FLDSVAL - array with index field name and value
  1. ; FLDSVALW - array with first index WP field name and the second values
  1. ; e.g FLDSVALW("URL",1)="Line1
  1. ; FLDSVALW("URL",2)="Line 2"
  1. ;
  1. ; Result values
  1. ; ===============
  1. ; if failed MAGRY = Failure status ^ Error message
  1. ; if success MAGRY = Success status ^ ^ IEN
  1. ;
  1. ;
  1. ADDRCD(MAGRY,FILE,FLDSVAL,FLDSVALW) ; Add a new record to a file
  1. N IENS,FLDNAME,FIELD,WPFLD
  1. N MAGDA,MAGNFDA,MAGNIEN,MAGNXE
  1. N MESSAGE,ERR
  1. N X,FLDSARR,FLDSARRW
  1. ;
  1. S X=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"") ; Get all fields
  1. ; Check if we set all required fields
  1. D REQFLDS^MAGVAF01(.MAGRY,FILE,.FLDSVAL,.FLDSARR,0) ;
  1. I '$$ISOK^MAGVAF02(MAGRY) Q
  1. ;
  1. ; Check for WP required fields
  1. D REQFLDS^MAGVAF01(.MAGRY,FILE,.FLDSVALW,.FLDSARRW,1) ;
  1. I '$$ISOK^MAGVAF02(MAGRY) Q
  1. ;
  1. ; Set FDA array and check for valid values
  1. S IENS="+1,"
  1. S FLDNAME=""
  1. S ERR=0
  1. F S FLDNAME=$O(FLDSVAL(FLDNAME)) Q:FLDNAME="" D Q:ERR
  1. . Q:FLDSVAL(FLDNAME)=""
  1. . S FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
  1. . K FLDSARR(FIELD) ; delete the field from the list; will use it in the check for check required fields
  1. . S MAGNFDA(FILE,IENS,FIELD)=FLDSVAL(FLDNAME)
  1. . S ERR='$$VALIDFLD^MAGVAF01(FILE,FIELD,FLDSVAL(FLDNAME),.MESSAGE)
  1. . Q
  1. I ERR S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MESSAGE Q
  1. ;
  1. ; Add the regular field first
  1. D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")
  1. ;
  1. I $D(MAGNXE("DIERR","E")) S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error adding a new record" Q
  1. S MAGDA=MAGNIEN(1) ; IEN of the new record
  1. ;
  1. ; Now store the Word-Processing fields
  1. S IENS=MAGDA_","
  1. S FLDNAME=""
  1. F S FLDNAME=$O(FLDSVALW(FLDNAME)) Q:FLDNAME="" D Q:ERR
  1. . K MAGNXE
  1. . S WPFLD=$$GETFLDID^MAGVAF01(FILE,FLDNAME) ; FileMan number of WP field
  1. . D WP^DIE(FILE,IENS,WPFLD,"A","FLDSVALW(FLDNAME)","MAGNXE")
  1. . I $D(MAGNXE("DIERR","E")) D Q ; clean up newly created record
  1. . . S ERR=1
  1. . . N DA,DIK
  1. . . S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error adding new """_FLDNAME_""" data."
  1. . . ; clean up data
  1. . . S DIK=$$GETFILGL^MAGVAF01(FILE)
  1. . . S DA=MAGDA
  1. . . D ^DIK
  1. . . Q
  1. . Q
  1. Q:ERR ; MAGRY is already set
  1. ;
  1. S MAGRY=$$OK^MAGVAF02()_$$RESDEL^MAGVAF02()_$$RESDEL^MAGVAF02()_MAGDA
  1. Q
  1. ;
  1. ; Update a record
  1. ;
  1. ; Input parameters
  1. ; ================
  1. ;
  1. ; FILE - file number
  1. ; FLDSVAL - FDA array
  1. ;
  1. ; Output parameter
  1. ; ===============
  1. ; MAGRY
  1. ;
  1. ; if failed MAGRY = Failure status ^ Error message
  1. ; if success MAGRY = Success status
  1. ;
  1. UPDRCD(MAGRY,FILE,FLDSVAL) ; Update a record to a file
  1. N IENS,FLDNAME,FIELD
  1. N MAGNFDA,MAGNIEN,MAGNXE
  1. N MESSAGE,ERR
  1. I '$G(FLDSVAL("PK")) S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Missing Primary Key (IEN)" Q
  1. S IENS=FLDSVAL("PK")_","
  1. S FLDNAME=""
  1. S ERR=0
  1. F S FLDNAME=$O(FLDSVAL(FLDNAME)) Q:FLDNAME="" D Q:ERR
  1. . Q:FLDNAME="PK" ; skip primary key record (IEN)
  1. . S FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
  1. . S MAGNFDA(FILE,IENS,FIELD)=FLDSVAL(FLDNAME)
  1. . S ERR='$$VALIDFLD^MAGVAF01(FILE,FIELD,FLDSVAL(FLDNAME),.MESSAGE)
  1. . Q
  1. I ERR S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MESSAGE Q
  1. ;
  1. D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")
  1. ;
  1. I $D(MAGNXE("DIERR","E")) S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error updating a record in file #"_FILE
  1. E S MAGRY=$$OK^MAGVAF02()
  1. Q