MAGVAF01 ;WOIFO/NST/DAC - Utilities for RPC calls ; 28 Feb 2013 9:58 AM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 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
IDF2FM(IDFDT) ; converts date time in format YYYYMMDD.HHMMSS to FileMan format CYYMMDD.HHMMSS
I IDFDT="" Q ""
N MAGTIME
S MAGTIME=$P(IDFDT,".",2)
Q (IDFDT\1-17000000)_"."_MAGTIME
;
FM2IDF(FMDT) ; converts date time in FileMan format CYYMMDD.HHMMSS to YYYYMMDD.HHMMSS
I FMDT="" Q ""
N MAGTIME
S MAGTIME=$P(FMDT,".",2)
Q (FMDT\1+17000000)_"."_MAGTIME
;
;
; Input parameters
; ================
; FILE = FileMan file number (e.g. 2006.917)
GETFILNM(FILE) ; Returns file name
Q $$GET1^DID(FILE,"","","NAME")
;
; Input parameters
; ================
; FILE - FileMan file
GETFILGL(FILE) ; Get Global root of the file
Q $$ROOT^DILFD(FILE)
;
; Input parameters
; ================
; FILE - FileMan file
; FNAME - Field name
GETFLDID(FILE,FNAME) ; Returns a field number
Q $$FLDNUM^DILFD(FILE,FNAME)
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
GETFLDNM(FILE,FLDID) ; Returns a field name
Q $$GET1^DID(FILE,FLDID,"","LABEL")
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
ISFLDDT(FILE,FLDID) ; Returns true(1) or false(0) if a field is from DATE/TIME type
Q $$GET1^DID(FILE,FLDID,"","TYPE")="DATE/TIME"
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
;
; Return Values
; =============
; TYPEDEF = Type of Word-Processing field
ISFLDWP(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type
N WPFILE
S TYPEDEF=""
Q:$$GET1^DID(FILE,FLDID,"","TYPE")'="WORD-PROCESSING" 0
S WPFILE=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
S TYPEDEF=$$GET1^DID(WPFILE,.01,"","SPECIFIER")
Q 1
;
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
;
; Return Values
; =============
; TYPEDEF = Type of field
ISFLDSUB(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type or Multiple
N FILESUB
S TYPEDEF=""
Q:'$$GET1^DID(FILE,FLDID,"","MULTIPLE-VALUED") 0
S FILESUB=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
S TYPEDEF=$$GET1^DID(FILESUB,.01,"","SPECIFIER")
Q 1
;
GETFLDS(MAGRY,MAGRYW,FILE,FLAGS) ; Returns array with all fields in a file
;
; Input Parameters
; ================
; FILE = FileMan file number
; FLAGS = I - add I(internal) to the field numbers in Result e.g .01I;2I;3I
;
; Return Values
; =============
;
; Result=n1;n2;n3 (e.g. .01;2;3) - no multiple or word-processing fields
;
; MAGRY(n)=nth field name
; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
;
; MAGRYW(n)=nth Word-Processing field name
; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
;
N I,FLDID,FLDS,DEL
N WPTYPE,IVAL
K MAGRY,MAGRYW
S IVAL=$S($G(FLAGS)["I":"I",1:"")
S I=""
S FLDS=""
F S I=$O(^DD(FILE,"B",I)) Q:I="" D ; IA #5551
. S FLDID=$O(^DD(FILE,"B",I,""))
. I $$ISFLDSUB^MAGVAF01(.WPTYPE,FILE,FLDID) D
. . S MAGRYW(FLDID)=I
. . S MAGRYW(FLDID,"TYPE")=WPTYPE
. . Q
. E D
. . S MAGRY(FLDID)=I
. . S MAGRY(FLDID,"TYPE")=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
. . Q
. Q
S I="",DEL=""
F S I=$O(MAGRY(I)) Q:I="" D
. ; Skip multiple and word-processing fields GETS^DIQ cannot handle Word-Processing field
. I $$ISFLDSUB^MAGVAF01(.WPTYPE,FILE,I) Q
. S FLDS=FLDS_DEL_I_IVAL
. S DEL=";"
. Q
Q FLDS
;
GETSUBFL(FILE,FIELD) ; Returns sub-file of a multiple field
Q $$GET1^DID(FILE,FIELD,"","SPECIFIER")
;
VALIDFLD(FILE,FIELD,VALUE,MESSAGE) ; call to validate value for field in a FM file.
; Function is boolean. Returns:
; 0 - Invalid
; 1 - Valid
; FILE : File Number
; FIELD : Field Number
; VALUE : (sent by reference) data value of field
; MESSAGE (sent by reference) Result message
;
N MAGR,MAGMSG,MAGSP,MAGRESA,MAGPT
; Get the Field number
I +FIELD'=FIELD S FIELD=$$GETFLDID^MAGVAF01(FILE,FIELD)
;if a BAD field number
I '$$VFIELD^DILFD(FILE,FIELD) D Q 0
. S MESSAGE="The field number: "_FIELD_", in File: "_FILE_", is invalid."
D FIELD^DID(FILE,FIELD,"","SPECIFIER","MAGSP")
; If it is a pointer field
; If an integer - We assume it is a pointer and validate that and Quit.
; If not integer - We assume it is external value, proceed to let CHK do validate
I (MAGSP("SPECIFIER")["P"),(+VALUE=VALUE) D Q MAGPT
. I $$EXTERNAL^DILFD(FILE,FIELD,"",VALUE)'="" S MAGPT=1 Q
. S MAGPT=0,MESSAGE="The value: "_VALUE_" for field: "_FIELD_" in File: "_FILE_" is an invalid Pointer."
. Q
;
D CHK^DIE(FILE,FIELD,"",VALUE,.MAGR,"MAGMSG")
; If success, Quit. We changed External to Internal. Internal is in MAGR
I MAGR'="^" Q 1
; If not success Get the error text and Quit 0
D MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
S MESSAGE=MAGRESA(1)
Q 0
;
;+++++ Check if all required fields are sent
;
;
; Input parameters
; ================
;
; FILE = file number
; FLDSVAL = array with fields values. Index of the array is fields names
; FLDSARR = array with fields definition. Index is field's numbers
; FLGWP = this is Word-processing fields
;
; Result Values
; =============
;
; if failure MAGRY = Failure status ^ Error message
; if success MAGRY = Success status
;
REQFLDS(MAGRY,FILE,FLDSVAL,FLDSARR,FLGWP) ;
N FLDNAME,MSG,ERR
N TFLDSARR
N WP
M TFLDSARR=FLDSARR
S FLDNAME=""
S ERR=0
F S FLDNAME=$O(FLDSVAL(FLDNAME)) Q:FLDNAME="" D Q:ERR
. I 'FLGWP Q:FLDSVAL(FLDNAME)="" ; value is empty, so get next one
. I FLGWP M WP=FLDSVAL(FLDNAME) Q:$$WPEMPTY^MAGVAF01(.WP) ; quit if WP field is blank
. S FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
. I FIELD="" D Q
. . S MSG="Field """_FLDNAME_""" is not found in file #"_FILE
. . S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MSG
. . S ERR=1
. . Q
. K TFLDSARR(FIELD) ; delete the field from the list; will use it in the check for check required fields
. Q
I ERR Q
; Check if we set all required fields
S FIELD=""
F S FIELD=$O(TFLDSARR(FIELD)) Q:FIELD="" D Q:ERR
. I TFLDSARR(FIELD,"TYPE")["R" D Q
. . S MSG="Field """_TFLDSARR(FIELD)_""" is required in file #"_FILE
. . S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MSG
. . S ERR=1
. . Q
. Q
Q:ERR
;
S MAGRY=$$OK^MAGVAF02()
Q
;
; Return WP field value as a string
; WP = Word-Processing field values
; e.g. WP(1)=Line 1
; WP(2)=Line 2
;
STRWP(WP) ; Return WP field value as a string
N I,RESULT
S I=""
S RESULT=""
F S I=$O(WP(I)) Q:I="" D
. S RESULT=RESULT_WP(I)
. Q
Q RESULT
;
; WP field value is blank
; Return 1 - WP field value is blank
; 0
; WP = Word-Processing field values
; e.g. WP(1)=Line 1
; WP(2)=Line 2
;
WPEMPTY(WP) ; Return 1 when WP field value is blank
N I,RESULT
S I=""
S RESULT=1
F S I=$O(WP(I)) Q:I=""!'RESULT D
. S RESULT=$L(WP(I))=0
. Q
Q RESULT
;
; Add a new record
;
; Input parameters
; ================
;
; FILE - file number
; FLDSVAL - array with index field name and value
; FLDSVALW - array with first index WP field name and the second values
; e.g FLDSVALW("URL",1)="Line1
; FLDSVALW("URL",2)="Line 2"
;
; Result values
; ===============
; if failed MAGRY = Failure status ^ Error message
; if success MAGRY = Success status ^ ^ IEN
;
;
ADDRCD(MAGRY,FILE,FLDSVAL,FLDSVALW) ; Add a new record to a file
N IENS,FLDNAME,FIELD,WPFLD
N MAGDA,MAGNFDA,MAGNIEN,MAGNXE
N MESSAGE,ERR
N X,FLDSARR,FLDSARRW
;
S X=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"") ; Get all fields
; Check if we set all required fields
D REQFLDS^MAGVAF01(.MAGRY,FILE,.FLDSVAL,.FLDSARR,0) ;
I '$$ISOK^MAGVAF02(MAGRY) Q
;
; Check for WP required fields
D REQFLDS^MAGVAF01(.MAGRY,FILE,.FLDSVALW,.FLDSARRW,1) ;
I '$$ISOK^MAGVAF02(MAGRY) Q
;
; Set FDA array and check for valid values
S IENS="+1,"
S FLDNAME=""
S ERR=0
F S FLDNAME=$O(FLDSVAL(FLDNAME)) Q:FLDNAME="" D Q:ERR
. Q:FLDSVAL(FLDNAME)=""
. S FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
. K FLDSARR(FIELD) ; delete the field from the list; will use it in the check for check required fields
. S MAGNFDA(FILE,IENS,FIELD)=FLDSVAL(FLDNAME)
. S ERR='$$VALIDFLD^MAGVAF01(FILE,FIELD,FLDSVAL(FLDNAME),.MESSAGE)
. Q
I ERR S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MESSAGE Q
;
; Add the regular field first
D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")
;
I $D(MAGNXE("DIERR","E")) S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error adding a new record" Q
S MAGDA=MAGNIEN(1) ; IEN of the new record
;
; Now store the Word-Processing fields
S IENS=MAGDA_","
S FLDNAME=""
F S FLDNAME=$O(FLDSVALW(FLDNAME)) Q:FLDNAME="" D Q:ERR
. K MAGNXE
. S WPFLD=$$GETFLDID^MAGVAF01(FILE,FLDNAME) ; FileMan number of WP field
. D WP^DIE(FILE,IENS,WPFLD,"A","FLDSVALW(FLDNAME)","MAGNXE")
. I $D(MAGNXE("DIERR","E")) D Q ; clean up newly created record
. . S ERR=1
. . N DA,DIK
. . S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error adding new """_FLDNAME_""" data."
. . ; clean up data
. . S DIK=$$GETFILGL^MAGVAF01(FILE)
. . S DA=MAGDA
. . D ^DIK
. . Q
. Q
Q:ERR ; MAGRY is already set
;
S MAGRY=$$OK^MAGVAF02()_$$RESDEL^MAGVAF02()_$$RESDEL^MAGVAF02()_MAGDA
Q
;
; Update a record
;
; Input parameters
; ================
;
; FILE - file number
; FLDSVAL - FDA array
;
; Output parameter
; ===============
; MAGRY
;
; if failed MAGRY = Failure status ^ Error message
; if success MAGRY = Success status
;
UPDRCD(MAGRY,FILE,FLDSVAL) ; Update a record to a file
N IENS,FLDNAME,FIELD
N MAGNFDA,MAGNIEN,MAGNXE
N MESSAGE,ERR
I '$G(FLDSVAL("PK")) S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Missing Primary Key (IEN)" Q
S IENS=FLDSVAL("PK")_","
S FLDNAME=""
S ERR=0
F S FLDNAME=$O(FLDSVAL(FLDNAME)) Q:FLDNAME="" D Q:ERR
. Q:FLDNAME="PK" ; skip primary key record (IEN)
. S FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
. S MAGNFDA(FILE,IENS,FIELD)=FLDSVAL(FLDNAME)
. S ERR='$$VALIDFLD^MAGVAF01(FILE,FIELD,FLDSVAL(FLDNAME),.MESSAGE)
. Q
I ERR S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MESSAGE Q
;
D UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")
;
I $D(MAGNXE("DIERR","E")) S MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error updating a record in file #"_FILE
E S MAGRY=$$OK^MAGVAF02()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVAF01 11711 printed Dec 13, 2024@02:09:17 Page 2
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
+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
IDF2FM(IDFDT) ; converts date time in format YYYYMMDD.HHMMSS to FileMan format CYYMMDD.HHMMSS
+1 IF IDFDT=""
QUIT ""
+2 NEW MAGTIME
+3 SET MAGTIME=$PIECE(IDFDT,".",2)
+4 QUIT (IDFDT\1-17000000)_"."_MAGTIME
+5 ;
FM2IDF(FMDT) ; converts date time in FileMan format CYYMMDD.HHMMSS to YYYYMMDD.HHMMSS
+1 IF FMDT=""
QUIT ""
+2 NEW MAGTIME
+3 SET MAGTIME=$PIECE(FMDT,".",2)
+4 QUIT (FMDT\1+17000000)_"."_MAGTIME
+5 ;
+6 ;
+7 ; Input parameters
+8 ; ================
+9 ; FILE = FileMan file number (e.g. 2006.917)
GETFILNM(FILE) ; Returns file name
+1 QUIT $$GET1^DID(FILE,"","","NAME")
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
GETFILGL(FILE) ; Get Global root of the file
+1 QUIT $$ROOT^DILFD(FILE)
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
+6 ; FNAME - Field name
GETFLDID(FILE,FNAME) ; Returns a field number
+1 QUIT $$FLDNUM^DILFD(FILE,FNAME)
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
+6 ; FLDID - Field Number
GETFLDNM(FILE,FLDID) ; Returns a field name
+1 QUIT $$GET1^DID(FILE,FLDID,"","LABEL")
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
+6 ; FLDID - Field Number
ISFLDDT(FILE,FLDID) ; Returns true(1) or false(0) if a field is from DATE/TIME type
+1 QUIT $$GET1^DID(FILE,FLDID,"","TYPE")="DATE/TIME"
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
+6 ; FLDID - Field Number
+7 ;
+8 ; Return Values
+9 ; =============
+10 ; TYPEDEF = Type of Word-Processing field
ISFLDWP(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type
+1 NEW WPFILE
+2 SET TYPEDEF=""
+3 if $$GET1^DID(FILE,FLDID,"","TYPE")'="WORD-PROCESSING"
QUIT 0
+4 SET WPFILE=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
+5 SET TYPEDEF=$$GET1^DID(WPFILE,.01,"","SPECIFIER")
+6 QUIT 1
+7 ;
+8 ;
+9 ; Input parameters
+10 ; ================
+11 ; FILE - FileMan file
+12 ; FLDID - Field Number
+13 ;
+14 ; Return Values
+15 ; =============
+16 ; TYPEDEF = Type of field
ISFLDSUB(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type or Multiple
+1 NEW FILESUB
+2 SET TYPEDEF=""
+3 if '$$GET1^DID(FILE,FLDID,"","MULTIPLE-VALUED")
QUIT 0
+4 SET FILESUB=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
+5 SET TYPEDEF=$$GET1^DID(FILESUB,.01,"","SPECIFIER")
+6 QUIT 1
+7 ;
GETFLDS(MAGRY,MAGRYW,FILE,FLAGS) ; Returns array with all fields in a file
+1 ;
+2 ; Input Parameters
+3 ; ================
+4 ; FILE = FileMan file number
+5 ; FLAGS = I - add I(internal) to the field numbers in Result e.g .01I;2I;3I
+6 ;
+7 ; Return Values
+8 ; =============
+9 ;
+10 ; Result=n1;n2;n3 (e.g. .01;2;3) - no multiple or word-processing fields
+11 ;
+12 ; MAGRY(n)=nth field name
+13 ; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
+14 ;
+15 ; MAGRYW(n)=nth Word-Processing field name
+16 ; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
+17 ;
+18 NEW I,FLDID,FLDS,DEL
+19 NEW WPTYPE,IVAL
+20 KILL MAGRY,MAGRYW
+21 SET IVAL=$SELECT($GET(FLAGS)["I":"I",1:"")
+22 SET I=""
+23 SET FLDS=""
+24 ; IA #5551
FOR
SET I=$ORDER(^DD(FILE,"B",I))
if I=""
QUIT
Begin DoDot:1
+25 SET FLDID=$ORDER(^DD(FILE,"B",I,""))
+26 IF $$ISFLDSUB^MAGVAF01(.WPTYPE,FILE,FLDID)
Begin DoDot:2
+27 SET MAGRYW(FLDID)=I
+28 SET MAGRYW(FLDID,"TYPE")=WPTYPE
+29 QUIT
End DoDot:2
+30 IF '$TEST
Begin DoDot:2
+31 SET MAGRY(FLDID)=I
+32 SET MAGRY(FLDID,"TYPE")=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 SET I=""
SET DEL=""
+36 FOR
SET I=$ORDER(MAGRY(I))
if I=""
QUIT
Begin DoDot:1
+37 ; Skip multiple and word-processing fields GETS^DIQ cannot handle Word-Processing field
+38 IF $$ISFLDSUB^MAGVAF01(.WPTYPE,FILE,I)
QUIT
+39 SET FLDS=FLDS_DEL_I_IVAL
+40 SET DEL=";"
+41 QUIT
End DoDot:1
+42 QUIT FLDS
+43 ;
GETSUBFL(FILE,FIELD) ; Returns sub-file of a multiple field
+1 QUIT $$GET1^DID(FILE,FIELD,"","SPECIFIER")
+2 ;
VALIDFLD(FILE,FIELD,VALUE,MESSAGE) ; call to validate value for field in a FM file.
+1 ; Function is boolean. Returns:
+2 ; 0 - Invalid
+3 ; 1 - Valid
+4 ; FILE : File Number
+5 ; FIELD : Field Number
+6 ; VALUE : (sent by reference) data value of field
+7 ; MESSAGE (sent by reference) Result message
+8 ;
+9 NEW MAGR,MAGMSG,MAGSP,MAGRESA,MAGPT
+10 ; Get the Field number
+11 IF +FIELD'=FIELD
SET FIELD=$$GETFLDID^MAGVAF01(FILE,FIELD)
+12 ;if a BAD field number
+13 IF '$$VFIELD^DILFD(FILE,FIELD)
Begin DoDot:1
+14 SET MESSAGE="The field number: "_FIELD_", in File: "_FILE_", is invalid."
End DoDot:1
QUIT 0
+15 DO FIELD^DID(FILE,FIELD,"","SPECIFIER","MAGSP")
+16 ; If it is a pointer field
+17 ; If an integer - We assume it is a pointer and validate that and Quit.
+18 ; If not integer - We assume it is external value, proceed to let CHK do validate
+19 IF (MAGSP("SPECIFIER")["P")
IF (+VALUE=VALUE)
Begin DoDot:1
+20 IF $$EXTERNAL^DILFD(FILE,FIELD,"",VALUE)'=""
SET MAGPT=1
QUIT
+21 SET MAGPT=0
SET MESSAGE="The value: "_VALUE_" for field: "_FIELD_" in File: "_FILE_" is an invalid Pointer."
+22 QUIT
End DoDot:1
QUIT MAGPT
+23 ;
+24 DO CHK^DIE(FILE,FIELD,"",VALUE,.MAGR,"MAGMSG")
+25 ; If success, Quit. We changed External to Internal. Internal is in MAGR
+26 IF MAGR'="^"
QUIT 1
+27 ; If not success Get the error text and Quit 0
+28 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
+29 SET MESSAGE=MAGRESA(1)
+30 QUIT 0
+31 ;
+32 ;+++++ Check if all required fields are sent
+33 ;
+34 ;
+35 ; Input parameters
+36 ; ================
+37 ;
+38 ; FILE = file number
+39 ; FLDSVAL = array with fields values. Index of the array is fields names
+40 ; FLDSARR = array with fields definition. Index is field's numbers
+41 ; FLGWP = this is Word-processing fields
+42 ;
+43 ; Result Values
+44 ; =============
+45 ;
+46 ; if failure MAGRY = Failure status ^ Error message
+47 ; if success MAGRY = Success status
+48 ;
REQFLDS(MAGRY,FILE,FLDSVAL,FLDSARR,FLGWP) ;
+1 NEW FLDNAME,MSG,ERR
+2 NEW TFLDSARR
+3 NEW WP
+4 MERGE TFLDSARR=FLDSARR
+5 SET FLDNAME=""
+6 SET ERR=0
+7 FOR
SET FLDNAME=$ORDER(FLDSVAL(FLDNAME))
if FLDNAME=""
QUIT
Begin DoDot:1
+8 ; value is empty, so get next one
IF 'FLGWP
if FLDSVAL(FLDNAME)=""
QUIT
+9 ; quit if WP field is blank
IF FLGWP
MERGE WP=FLDSVAL(FLDNAME)
if $$WPEMPTY^MAGVAF01(.WP)
QUIT
+10 SET FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
+11 IF FIELD=""
Begin DoDot:2
+12 SET MSG="Field """_FLDNAME_""" is not found in file #"_FILE
+13 SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MSG
+14 SET ERR=1
+15 QUIT
End DoDot:2
QUIT
+16 ; delete the field from the list; will use it in the check for check required fields
KILL TFLDSARR(FIELD)
+17 QUIT
End DoDot:1
if ERR
QUIT
+18 IF ERR
QUIT
+19 ; Check if we set all required fields
+20 SET FIELD=""
+21 FOR
SET FIELD=$ORDER(TFLDSARR(FIELD))
if FIELD=""
QUIT
Begin DoDot:1
+22 IF TFLDSARR(FIELD,"TYPE")["R"
Begin DoDot:2
+23 SET MSG="Field """_TFLDSARR(FIELD)_""" is required in file #"_FILE
+24 SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MSG
+25 SET ERR=1
+26 QUIT
End DoDot:2
QUIT
+27 QUIT
End DoDot:1
if ERR
QUIT
+28 if ERR
QUIT
+29 ;
+30 SET MAGRY=$$OK^MAGVAF02()
+31 QUIT
+32 ;
+33 ; Return WP field value as a string
+34 ; WP = Word-Processing field values
+35 ; e.g. WP(1)=Line 1
+36 ; WP(2)=Line 2
+37 ;
STRWP(WP) ; Return WP field value as a string
+1 NEW I,RESULT
+2 SET I=""
+3 SET RESULT=""
+4 FOR
SET I=$ORDER(WP(I))
if I=""
QUIT
Begin DoDot:1
+5 SET RESULT=RESULT_WP(I)
+6 QUIT
End DoDot:1
+7 QUIT RESULT
+8 ;
+9 ; WP field value is blank
+10 ; Return 1 - WP field value is blank
+11 ; 0
+12 ; WP = Word-Processing field values
+13 ; e.g. WP(1)=Line 1
+14 ; WP(2)=Line 2
+15 ;
WPEMPTY(WP) ; Return 1 when WP field value is blank
+1 NEW I,RESULT
+2 SET I=""
+3 SET RESULT=1
+4 FOR
SET I=$ORDER(WP(I))
if I=""!'RESULT
QUIT
Begin DoDot:1
+5 SET RESULT=$LENGTH(WP(I))=0
+6 QUIT
End DoDot:1
+7 QUIT RESULT
+8 ;
+9 ; Add a new record
+10 ;
+11 ; Input parameters
+12 ; ================
+13 ;
+14 ; FILE - file number
+15 ; FLDSVAL - array with index field name and value
+16 ; FLDSVALW - array with first index WP field name and the second values
+17 ; e.g FLDSVALW("URL",1)="Line1
+18 ; FLDSVALW("URL",2)="Line 2"
+19 ;
+20 ; Result values
+21 ; ===============
+22 ; if failed MAGRY = Failure status ^ Error message
+23 ; if success MAGRY = Success status ^ ^ IEN
+24 ;
+25 ;
ADDRCD(MAGRY,FILE,FLDSVAL,FLDSVALW) ; Add a new record to a file
+1 NEW IENS,FLDNAME,FIELD,WPFLD
+2 NEW MAGDA,MAGNFDA,MAGNIEN,MAGNXE
+3 NEW MESSAGE,ERR
+4 NEW X,FLDSARR,FLDSARRW
+5 ;
+6 ; Get all fields
SET X=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"")
+7 ; Check if we set all required fields
+8 ;
DO REQFLDS^MAGVAF01(.MAGRY,FILE,.FLDSVAL,.FLDSARR,0)
+9 IF '$$ISOK^MAGVAF02(MAGRY)
QUIT
+10 ;
+11 ; Check for WP required fields
+12 ;
DO REQFLDS^MAGVAF01(.MAGRY,FILE,.FLDSVALW,.FLDSARRW,1)
+13 IF '$$ISOK^MAGVAF02(MAGRY)
QUIT
+14 ;
+15 ; Set FDA array and check for valid values
+16 SET IENS="+1,"
+17 SET FLDNAME=""
+18 SET ERR=0
+19 FOR
SET FLDNAME=$ORDER(FLDSVAL(FLDNAME))
if FLDNAME=""
QUIT
Begin DoDot:1
+20 if FLDSVAL(FLDNAME)=""
QUIT
+21 SET FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
+22 ; delete the field from the list; will use it in the check for check required fields
KILL FLDSARR(FIELD)
+23 SET MAGNFDA(FILE,IENS,FIELD)=FLDSVAL(FLDNAME)
+24 SET ERR='$$VALIDFLD^MAGVAF01(FILE,FIELD,FLDSVAL(FLDNAME),.MESSAGE)
+25 QUIT
End DoDot:1
if ERR
QUIT
+26 IF ERR
SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MESSAGE
QUIT
+27 ;
+28 ; Add the regular field first
+29 DO UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")
+30 ;
+31 IF $DATA(MAGNXE("DIERR","E"))
SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error adding a new record"
QUIT
+32 ; IEN of the new record
SET MAGDA=MAGNIEN(1)
+33 ;
+34 ; Now store the Word-Processing fields
+35 SET IENS=MAGDA_","
+36 SET FLDNAME=""
+37 FOR
SET FLDNAME=$ORDER(FLDSVALW(FLDNAME))
if FLDNAME=""
QUIT
Begin DoDot:1
+38 KILL MAGNXE
+39 ; FileMan number of WP field
SET WPFLD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
+40 DO WP^DIE(FILE,IENS,WPFLD,"A","FLDSVALW(FLDNAME)","MAGNXE")
+41 ; clean up newly created record
IF $DATA(MAGNXE("DIERR","E"))
Begin DoDot:2
+42 SET ERR=1
+43 NEW DA,DIK
+44 SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error adding new """_FLDNAME_""" data."
+45 ; clean up data
+46 SET DIK=$$GETFILGL^MAGVAF01(FILE)
+47 SET DA=MAGDA
+48 DO ^DIK
+49 QUIT
End DoDot:2
QUIT
+50 QUIT
End DoDot:1
if ERR
QUIT
+51 ; MAGRY is already set
if ERR
QUIT
+52 ;
+53 SET MAGRY=$$OK^MAGVAF02()_$$RESDEL^MAGVAF02()_$$RESDEL^MAGVAF02()_MAGDA
+54 QUIT
+55 ;
+56 ; Update a record
+57 ;
+58 ; Input parameters
+59 ; ================
+60 ;
+61 ; FILE - file number
+62 ; FLDSVAL - FDA array
+63 ;
+64 ; Output parameter
+65 ; ===============
+66 ; MAGRY
+67 ;
+68 ; if failed MAGRY = Failure status ^ Error message
+69 ; if success MAGRY = Success status
+70 ;
UPDRCD(MAGRY,FILE,FLDSVAL) ; Update a record to a file
+1 NEW IENS,FLDNAME,FIELD
+2 NEW MAGNFDA,MAGNIEN,MAGNXE
+3 NEW MESSAGE,ERR
+4 IF '$GET(FLDSVAL("PK"))
SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Missing Primary Key (IEN)"
QUIT
+5 SET IENS=FLDSVAL("PK")_","
+6 SET FLDNAME=""
+7 SET ERR=0
+8 FOR
SET FLDNAME=$ORDER(FLDSVAL(FLDNAME))
if FLDNAME=""
QUIT
Begin DoDot:1
+9 ; skip primary key record (IEN)
if FLDNAME="PK"
QUIT
+10 SET FIELD=$$GETFLDID^MAGVAF01(FILE,FLDNAME)
+11 SET MAGNFDA(FILE,IENS,FIELD)=FLDSVAL(FLDNAME)
+12 SET ERR='$$VALIDFLD^MAGVAF01(FILE,FIELD,FLDSVAL(FLDNAME),.MESSAGE)
+13 QUIT
End DoDot:1
if ERR
QUIT
+14 IF ERR
SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_MESSAGE
QUIT
+15 ;
+16 DO UPDATE^DIE("S","MAGNFDA","MAGNIEN","MAGNXE")
+17 ;
+18 IF $DATA(MAGNXE("DIERR","E"))
SET MAGRY=$$FAILED^MAGVAF02()_$$RESDEL^MAGVAF02()_"Error updating a record in file #"_FILE
+19 IF '$TEST
SET MAGRY=$$OK^MAGVAF02()
+20 QUIT
