- 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 Jan 18, 2025@03:10:29 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