MAGVAF03 ;WOIFO/NST/BT - Utilities for RPC calls ; 15 May 2012 9:15 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
;
;***** Returns all records for a file in list format
; Input Parameters
; ================
;
; FILE - FileMan file number ( example 2006.917)
; IENS - (Optional) Identify which records in a subfile to list. (example IENS = ",67,"
;
; Return values
; =============
;
; if error found during execution
; MAGRY(0) = Failure status ^ Error getting the list
; if success
; MAGRY(0) = "Success status ^^#CNT" - where #CNT is a number of records returned
; MAGRY(1) = "^" delimited string with all field names in FILE
; MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
;
GALLLST(MAGRY,FILE,IENS) ;
N OUT,ERR,MAGRESA
N J,I,CNT,X,FIELDS,FLDSARR,FLDSARRW
N RESDEL
N IRECCNT ;Record count for internal values
N ERECCNT ;Record count for external values
K MAGRY
S RESDEL=$$RESDEL^MAGVAF02() ; Result delimiter
S FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"")
;
; Retrieve all external values to check for valid pointer or referential integrity problems
D LIST^DIC(FILE,IENS,"@;"_FIELDS,"","","","","","","","OUT","ERR")
I $D(ERR("DIERR")) D Q ; Error getting the list with external values
. D MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
. S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: "_MAGRESA(1)
. Q
S ERECCNT=$P($G(OUT("DILIST","0")),"^",1)
;
; Retrieve all Internal values to return to the caller
K OUT,ERR
D LIST^DIC(FILE,IENS,"@;"_FIELDS,"I","","","","","","","OUT","ERR")
I $D(ERR("DIERR")) D Q ; Error getting the list with internal values
. D MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
. S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: "_MAGRESA(1)
. Q
S IRECCNT=$P($G(OUT("DILIST","0")),"^",1)
;
I IRECCNT'=ERECCNT D Q
. S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: File #"_FILE_" has cross reference problem" Q
;
S CNT=1
S I=""
F S I=$O(OUT("DILIST","ID",I)) Q:I="" D
. S CNT=CNT+1
. S $P(MAGRY(CNT),"^",1)=OUT("DILIST",2,I)
. F J=1:1:$L(FIELDS,";") D
. . S X=OUT("DILIST","ID",I,$P(FIELDS,";",J))
. . I $$ISFLDDT^MAGVAF01(FILE,$P(FIELDS,";",J)) S X=$$FM2IDF^MAGVAF01(X) ; the field is Date type - convert to IDF format
. . S $P(MAGRY(CNT),RESDEL,J+1)=X
. . Q
. Q
;
S MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_(CNT-1)
S MAGRY(1)="IEN"
S I=""
F S I=$O(FLDSARR(I)) Q:I="" S MAGRY(1)=MAGRY(1)_RESDEL_FLDSARR(I)
Q
;***** Returns all records for a file in XML format
; Input Parameters
; ================
;
; FILE - FileMan file number ( example 2006.917)
; IENS - (Optional) Identify which subfile to list. (example IENS = ",67,"
;
; if error found during execution
; MAGRY(0) = "Failure status ^Error getting the list"
; if success
; MAGRY(0) = Success status ^^Total of lines
; MAGRY(1) = <file name + "s">
; MAGRY(2) = <file name>
; MAGRY(2..m) = <field name=value>
; MAGRY(n+1) = </ file name >
; ...
; MAGRY(n+2) = </ file name + "s">
;
GALLXML(MAGRY,FILE,IENS) ;
N OUT,ERR,MAGRESA
N I,J,L,CNT,X,Y,WP,WPTYPE,QT,RESDEL
N FILENM,FIELDS,FLDSARR,FLDSARRW
K MAGRY
S QT=$C(34)
S RESDEL=$$RESDEL^MAGVAF02()
S FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"") ; Get fields
D LIST^DIC(FILE,IENS,"@;"_FIELDS,"I","","","","","","","OUT","ERR")
I $D(ERR("DIERR")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
. S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: "_MAGRESA(1) Q ; Error getting the list
S FILENM=$TR($$GETFILNM^MAGVAF01(FILE)," ") ; file name without blanks
S CNT=0
S CNT=CNT+1,MAGRY(1)="<"_FILENM_"S>"
S I=""
F S I=$O(OUT("DILIST","ID",I)) Q:I="" D
. S CNT=CNT+1,MAGRY(CNT)="<"_FILENM
. S CNT=CNT+1,MAGRY(CNT)="PK="_QT_OUT("DILIST",2,I)_QT
. S J=""
. F S J=$O(OUT("DILIST","ID",I,J)) Q:J="" D
. . S X=OUT("DILIST","ID",I,J)
. . I $$ISFLDDT^MAGVAF01(FILE,J) S X=$$FM2IDF^MAGVAF01(X) ; the field is Date type - convert to IDF format
. . S CNT=CNT+1,MAGRY(CNT)=$TR(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
. ; Now get the Word-Processing fields
. S J=""
. K WP
. F S J=$O(FLDSARRW(J)) Q:J="" D
. . I $$ISFLDWP^MAGVAF01(.WPTYPE,FILE,J) D
. . . S X=$$GET1^DIQ(FILE,OUT("DILIST",2,I),J,"","WP")
. . . S:$D(WP) CNT=CNT+1,MAGRY(CNT)=$TR(FLDSARRW(J)," /\<>&%")_"="_QT
. . . S L=""
. . . F S L=$O(WP(L)) Q:L="" D
. . . . S CNT=CNT+1,MAGRY(CNT)=WP(L)
. . . . Q
. . . S MAGRY(CNT)=MAGRY(CNT)_QT
. . . Q
. . Q
. S MAGRY(CNT)=MAGRY(CNT)_" >"
. Q
S CNT=CNT+1,MAGRY(CNT)="</"_FILENM_">"
S CNT=CNT+1,MAGRY(CNT)="</"_FILENM_"S>"
S MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
Q
;
; **** Get a multiple values for a field and return the result in XML format
;
; Input parameters
; ================
;
; FILE = FileMan number of the file (e.g. 2006.913)
; IENS = IEN of the record (e.g. "1," where 1 is an IEN)
; MFIELDID = Field number of the multiple field (e.g. 2)
;
; Return Values
; =============
; if error found during execution
; MAGRY(0) = "Failure status ^Error getting values"
; if success
; MAGRY(0) = Success status ^^Total lines
; MAGRY (1.n) = values in format
;
; e.g
; <KEYS>
; <KEY VALUE="" LEVEL=""/>
; ...
; <KEY VALUE="" LEVEL=""/>
; </KEYS>
;
; where
; KEY = the name of multiple field
; VALUE and LEVEL = field names in sub-file
;
GETMVAL(MAGRY,FILE,MFIELDID,IENS) ;
N I,J,X
N OUT,ERR,MAGRESA
N FLDSARR,FLDSARRW,MFIELDNM,SUBFILE,FIELDS
N CNT,QT,RESDEL
S QT=$C(34)
S RESDEL=$$RESDEL^MAGVAF02()
S MFIELDNM=$$GETFLDNM^MAGVAF01(FILE,MFIELDID) ; name of multiple field
S SUBFILE=$$GETSUBFL^MAGVAF01(FILE,MFIELDID) ; sub-file for the multiple fields
S FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,SUBFILE,"I") ; sub-file fields names
S FIELDS=MFIELDID_"*"
I IENS'="" D Q:$D(ERR("DIERR"))
. D GETS^DIQ(FILE,IENS,FIELDS,"","OUT","ERR")
. I $D(ERR("DIERR")) D
. . D MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
. . S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1) Q ; Error getting the list
. . Q
. Q
; Output the data
S I="" ; IENs
S J="" ; Fields in the sub-file
S CNT=0
S CNT=CNT+1,MAGRY(CNT)="<"_MFIELDNM_"S>"
F S I=$O(OUT(SUBFILE,I)) Q:I="" D
. S CNT=CNT+1,MAGRY(CNT)="<"_MFIELDNM
. F S J=$O(OUT(SUBFILE,I,J)) Q:J="" D
. . I $$ISFLDDT^MAGVAF01(SUBFILE,J) S X=$$FM2IDF^MAGVAF01(OUT(SUBFILE,I,J)) ; the field is Date type - convert to IDF format
. . E S X=OUT(SUBFILE,I,J)
. . S MAGRY(CNT)=MAGRY(CNT)_" "_$TR(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
. . Q
. S MAGRY(CNT)=MAGRY(CNT)_" />"
. Q
. S CNT=CNT+1,MAGRY(CNT)="/>"
S CNT=CNT+1,MAGRY(CNT)="</"_MFIELDNM_"S>"
S MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
Q
;
;
; **** Get a record from a file by "B" index value
; (in most of the cases it is value of .01 field) and return the result in XML format
;
; Input parameters
; ================
;
; FILE = FileMan number of the file (e.g. 2006.913)
; IENS = IEN in sub-file (e.g. "1," where 1 is an IEN)
; VAL = value in "B" index (in most of the cases it is value of .01 field)
; WPASLINE = 0 (WP value as it was stored) / 1 (WP value as a single line)
;
; Return Values
; =============
; if error found during execution
; MAGRY(0) = Failure status^Error getting values
; if success
; MAGRY(0) = Success status^^Total lines
; MAGRY (1.n) = values in XML format
;
GXMLBYID(MAGRY,FILE,IENS,VAL,WPASLINE) ;
N FIELDS,FLDSARR,FLDSARRW,FILENM
N OUT,ERR,MAGRESA,WP,WPTYPE
N I,J,L,X,CNT
N QT,RESDEL
K MAGRY
S RESDEL=$$RESDEL^MAGVAF02()
S QT=$C(34)
S FILENM=$TR($$GETFILNM^MAGVAF01(FILE)," ") ; File name without blank
S FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"I") ; file fields names
D FIND^DIC(FILE,IENS,"@;"_FIELDS,"BQX",VAL,"","","","","OUT","ERR")
I $D(ERR("DIERR")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
. S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1) Q ; Error getting the list
. Q
; Output the data
S CNT=0
S CNT=CNT+1,MAGRY(CNT)="<"_FILENM_"S>"
S I="" ; IENs
S J="" ; Fields in the file
F S I=$O(OUT("DILIST","ID",I)) Q:I="" D
. S CNT=CNT+1,MAGRY(CNT)="<"_FILENM
. S CNT=CNT+1,MAGRY(CNT)="PK="_QT_OUT("DILIST",2,I)_QT
. S J=""
. F S J=$O(OUT("DILIST","ID",I,J)) Q:J="" D
. . S X=OUT("DILIST","ID",I,J)
. . I $$ISFLDDT^MAGVAF01(FILE,J) S X=$$FM2IDF^MAGVAF01(X) ; the field is Date type - convert to IDF format
. . S CNT=CNT+1,MAGRY(CNT)=$TR(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
. . Q
. ; Now get the Word-Processing fields
. S J=""
. K WP
. F S J=$O(FLDSARRW(J)) Q:J="" D
. . I $$ISFLDWP^MAGVAF01(.WPTYPE,FILE,J) D Q
. . . S X=$$GET1^DIQ(FILE,OUT("DILIST",2,I),J,"","WP")
. . . I $D(WP) D
. . . . S CNT=CNT+1,MAGRY(CNT)=$TR(FLDSARRW(J)," /\<>&%")_"="_QT
. . . . I WPASLINE S MAGRY(CNT)=MAGRY(CNT)_$$TRHTML^MAGVAF04($$STRWP^MAGVAF01(.WP)) ; Get as a single line
. . . . E D ; Get WP value as it was stored
. . . . . S L=""
. . . . . F S L=$O(WP(L)) Q:L="" D
. . . . . . S CNT=CNT+1,MAGRY(CNT)=$$TRHTML^MAGVAF04(WP(L))
. . . . . . Q
. . . . . Q
. . . . S MAGRY(CNT)=MAGRY(CNT)_QT
. . . . Q
. . . Q
. . Q
. S MAGRY(CNT)=MAGRY(CNT)_" >"
. S CNT=CNT+1,MAGRY(CNT)="</"_FILENM_" >"
. Q
S CNT=CNT+1,MAGRY(CNT)="</"_FILENM_"S>"
S MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
Q
;
; Input Parameters
; ================
; MAGRY
; MAGRY(0)=1^^CNT
; MAGRY(3)=<FILENAME
; ...
; MAGRY(n)=</FILENAME>
;
; Output Values
; =============
;
; MAGRY(0)=1^^(CNT+1)
; MAGRY(1)="<?xml version=""1.0"" encoding=""utf-8""?>"
; MAGRY(2)=<FILENAMES>
; ....
; MAGRY(n+1)=</FILENAMES>
;
SETFTUCH(MAGRY) ; Set first two lines and the last one
I '$$ISOK^MAGVAF02(MAGRY(0)) Q
; Add first lines
N RES,I
S MAGRY(1)=$$XML1LINE^MAGVAF02()
S MAGRY(2)=MAGRY(3)_"S>"
S I=$O(MAGRY(""),-1)+1
S MAGRY(I)="</"_$P(MAGRY(3),"<",2,999)_"S>"
S RES=MAGRY(0)
D SETVAL^MAGVAF02(.RES,I)
S MAGRY(0)=RES
Q
;
;++++ Create an empty XML result by file number
; Input Parameters
; ================
; FILE - FileMan file number
;
; Return Values
; ==============
; MAGRY(0)=1^^3
; MAGRY(1)="<?xml version=""1.0"" encoding=""utf-8""?>"
; MAGRY(2)=<FILENAMES>
; MAGRY(3)=</FILENAMES>
;
; where FILENAME is the name of the file passed
;
EMPTYXML(MAGRY,FILE) ; Create an empty XML result by file number
N FILENM
S FILENM=$TR($$GETFILNM^MAGVAF01(FILE)," ") ; File name without blank
S CNT=0
S MAGRY(0)=$$OK^MAGVAF02()_$$RESDEL^MAGVAF02()_$$RESDEL^MAGVAF02()_3
S MAGRY(1)=$$XML1LINE^MAGVAF02()
S MAGRY(2)="<"_FILENM_"S>"
S MAGRY(3)="</"_FILENM_"S>"
Q
;
; **** Get a record from a file by IEN
; and return the result in XML format
;
; Input parameters
; ================
;
; FILE = FileMan number of the file (e.g. 2006.913)
; PK = IEN in the file
; WPASLINE = 0 (WP value as it was stored) / 1 (WP value as a single line)
;
; Return Values
; =============
; if error found during execution
; MAGRY(0) = Failure status^Error getting values
; if success
; MAGRY(0) = Success status^^Total lines
; MAGRY (1.n) = values in XML format
;
GXMLBYPK(MAGRY,FILE,PK,WPASLINE) ;
N FIELDS,FLDSARR,FLDSARRW,FILENM
N OUT,ERR,MAGRESA,WP,IENS
N J,L,X,CNT,WPTYPE
N QT,RESDEL
K MAGRY
S RESDEL=$$RESDEL^MAGVAF02()
S QT=$C(34)
S FILENM=$TR($$GETFILNM^MAGVAF01(FILE)," ") ; File name without blank
S FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"") ; file fields names
S IENS=PK_","
D GETS^DIQ(FILE,PK_",",FIELDS,"I","OUT","ERR")
I $D(ERR("DIERR")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
. S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1) Q ; Error getting the list
. Q
; Output the data
S CNT=0
S J="" ; Fields in the file
S CNT=CNT+1,MAGRY(CNT)="<"_FILENM
S CNT=CNT+1,MAGRY(CNT)="PK="_QT_PK_QT
S J=""
F S J=$O(OUT(FILE,IENS,J)) Q:J="" D
. S X=OUT(FILE,IENS,J,"I")
. I $$ISFLDDT^MAGVAF01(FILE,J) S X=$$FM2IDF^MAGVAF01(X) ; the field is Date type - convert to IDF format
. S CNT=CNT+1,MAGRY(CNT)=$TR(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
. Q
; Now get the Word-Processing fields
S J=""
K WP
F S J=$O(FLDSARRW(J)) Q:J="" D
. I $$ISFLDWP^MAGVAF01(.WPTYPE,FILE,J) D Q
. . S X=$$GET1^DIQ(FILE,IENS,J,"","WP")
. . I $D(WP) D
. . . S CNT=CNT+1,MAGRY(CNT)=$TR(FLDSARRW(J)," /\<>&%")_"="_QT
. . . I WPASLINE S MAGRY(CNT)=MAGRY(CNT)_$$TRHTML^MAGVAF04($$STRWP^MAGVAF01(.WP)) ; Get as a single line
. . . E D ; Get WP value as it was stored
. . . . S L=""
. . . . F S L=$O(WP(L)) Q:L="" D
. . . . . S CNT=CNT+1,MAGRY(CNT)=$$TRHTML^MAGVAF04(WP(L))
. . . . . Q
. . . . Q
. . . S MAGRY(CNT)=MAGRY(CNT)_QT
. . . Q
. . Q
. Q
S MAGRY(CNT)=MAGRY(CNT)_" >"
S CNT=CNT+1,MAGRY(CNT)="</"_FILENM_" >"
S MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVAF03 14253 printed Oct 16, 2024@18:10 Page 2
MAGVAF03 ;WOIFO/NST/BT - Utilities for RPC calls ; 15 May 2012 9:15 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
+18 ;
+19 ;***** Returns all records for a file in list format
+20 ; Input Parameters
+21 ; ================
+22 ;
+23 ; FILE - FileMan file number ( example 2006.917)
+24 ; IENS - (Optional) Identify which records in a subfile to list. (example IENS = ",67,"
+25 ;
+26 ; Return values
+27 ; =============
+28 ;
+29 ; if error found during execution
+30 ; MAGRY(0) = Failure status ^ Error getting the list
+31 ; if success
+32 ; MAGRY(0) = "Success status ^^#CNT" - where #CNT is a number of records returned
+33 ; MAGRY(1) = "^" delimited string with all field names in FILE
+34 ; MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
+35 ;
GALLLST(MAGRY,FILE,IENS) ;
+1 NEW OUT,ERR,MAGRESA
+2 NEW J,I,CNT,X,FIELDS,FLDSARR,FLDSARRW
+3 NEW RESDEL
+4 ;Record count for internal values
NEW IRECCNT
+5 ;Record count for external values
NEW ERECCNT
+6 KILL MAGRY
+7 ; Result delimiter
SET RESDEL=$$RESDEL^MAGVAF02()
+8 SET FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"")
+9 ;
+10 ; Retrieve all external values to check for valid pointer or referential integrity problems
+11 DO LIST^DIC(FILE,IENS,"@;"_FIELDS,"","","","","","","","OUT","ERR")
+12 ; Error getting the list with external values
IF $DATA(ERR("DIERR"))
Begin DoDot:1
+13 DO MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
+14 SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: "_MAGRESA(1)
+15 QUIT
End DoDot:1
QUIT
+16 SET ERECCNT=$PIECE($GET(OUT("DILIST","0")),"^",1)
+17 ;
+18 ; Retrieve all Internal values to return to the caller
+19 KILL OUT,ERR
+20 DO LIST^DIC(FILE,IENS,"@;"_FIELDS,"I","","","","","","","OUT","ERR")
+21 ; Error getting the list with internal values
IF $DATA(ERR("DIERR"))
Begin DoDot:1
+22 DO MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
+23 SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: "_MAGRESA(1)
+24 QUIT
End DoDot:1
QUIT
+25 SET IRECCNT=$PIECE($GET(OUT("DILIST","0")),"^",1)
+26 ;
+27 IF IRECCNT'=ERECCNT
Begin DoDot:1
+28 SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: File #"_FILE_" has cross reference problem"
QUIT
End DoDot:1
QUIT
+29 ;
+30 SET CNT=1
+31 SET I=""
+32 FOR
SET I=$ORDER(OUT("DILIST","ID",I))
if I=""
QUIT
Begin DoDot:1
+33 SET CNT=CNT+1
+34 SET $PIECE(MAGRY(CNT),"^",1)=OUT("DILIST",2,I)
+35 FOR J=1:1:$LENGTH(FIELDS,";")
Begin DoDot:2
+36 SET X=OUT("DILIST","ID",I,$PIECE(FIELDS,";",J))
+37 ; the field is Date type - convert to IDF format
IF $$ISFLDDT^MAGVAF01(FILE,$PIECE(FIELDS,";",J))
SET X=$$FM2IDF^MAGVAF01(X)
+38 SET $PIECE(MAGRY(CNT),RESDEL,J+1)=X
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 ;
+42 SET MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_(CNT-1)
+43 SET MAGRY(1)="IEN"
+44 SET I=""
+45 FOR
SET I=$ORDER(FLDSARR(I))
if I=""
QUIT
SET MAGRY(1)=MAGRY(1)_RESDEL_FLDSARR(I)
+46 QUIT
+47 ;***** Returns all records for a file in XML format
+48 ; Input Parameters
+49 ; ================
+50 ;
+51 ; FILE - FileMan file number ( example 2006.917)
+52 ; IENS - (Optional) Identify which subfile to list. (example IENS = ",67,"
+53 ;
+54 ; if error found during execution
+55 ; MAGRY(0) = "Failure status ^Error getting the list"
+56 ; if success
+57 ; MAGRY(0) = Success status ^^Total of lines
+58 ; MAGRY(1) = <file name + "s">
+59 ; MAGRY(2) = <file name>
+60 ; MAGRY(2..m) = <field name=value>
+61 ; MAGRY(n+1) = </ file name >
+62 ; ...
+63 ; MAGRY(n+2) = </ file name + "s">
+64 ;
GALLXML(MAGRY,FILE,IENS) ;
+1 NEW OUT,ERR,MAGRESA
+2 NEW I,J,L,CNT,X,Y,WP,WPTYPE,QT,RESDEL
+3 NEW FILENM,FIELDS,FLDSARR,FLDSARRW
+4 KILL MAGRY
+5 SET QT=$CHAR(34)
+6 SET RESDEL=$$RESDEL^MAGVAF02()
+7 ; Get fields
SET FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"")
+8 DO LIST^DIC(FILE,IENS,"@;"_FIELDS,"I","","","","","","","OUT","ERR")
+9 IF $DATA(ERR("DIERR"))
Begin DoDot:1
+10 DO MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
+11 ; Error getting the list
SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting the list: "_MAGRESA(1)
QUIT
End DoDot:1
QUIT
+12 ; file name without blanks
SET FILENM=$TRANSLATE($$GETFILNM^MAGVAF01(FILE)," ")
+13 SET CNT=0
+14 SET CNT=CNT+1
SET MAGRY(1)="<"_FILENM_"S>"
+15 SET I=""
+16 FOR
SET I=$ORDER(OUT("DILIST","ID",I))
if I=""
QUIT
Begin DoDot:1
+17 SET CNT=CNT+1
SET MAGRY(CNT)="<"_FILENM
+18 SET CNT=CNT+1
SET MAGRY(CNT)="PK="_QT_OUT("DILIST",2,I)_QT
+19 SET J=""
+20 FOR
SET J=$ORDER(OUT("DILIST","ID",I,J))
if J=""
QUIT
Begin DoDot:2
+21 SET X=OUT("DILIST","ID",I,J)
+22 ; the field is Date type - convert to IDF format
IF $$ISFLDDT^MAGVAF01(FILE,J)
SET X=$$FM2IDF^MAGVAF01(X)
+23 SET CNT=CNT+1
SET MAGRY(CNT)=$TRANSLATE(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
End DoDot:2
+24 ; Now get the Word-Processing fields
+25 SET J=""
+26 KILL WP
+27 FOR
SET J=$ORDER(FLDSARRW(J))
if J=""
QUIT
Begin DoDot:2
+28 IF $$ISFLDWP^MAGVAF01(.WPTYPE,FILE,J)
Begin DoDot:3
+29 SET X=$$GET1^DIQ(FILE,OUT("DILIST",2,I),J,"","WP")
+30 if $DATA(WP)
SET CNT=CNT+1
SET MAGRY(CNT)=$TRANSLATE(FLDSARRW(J)," /\<>&%")_"="_QT
+31 SET L=""
+32 FOR
SET L=$ORDER(WP(L))
if L=""
QUIT
Begin DoDot:4
+33 SET CNT=CNT+1
SET MAGRY(CNT)=WP(L)
+34 QUIT
End DoDot:4
+35 SET MAGRY(CNT)=MAGRY(CNT)_QT
+36 QUIT
End DoDot:3
+37 QUIT
End DoDot:2
+38 SET MAGRY(CNT)=MAGRY(CNT)_" >"
+39 QUIT
End DoDot:1
+40 SET CNT=CNT+1
SET MAGRY(CNT)="</"_FILENM_">"
+41 SET CNT=CNT+1
SET MAGRY(CNT)="</"_FILENM_"S>"
+42 SET MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
+43 QUIT
+44 ;
+45 ; **** Get a multiple values for a field and return the result in XML format
+46 ;
+47 ; Input parameters
+48 ; ================
+49 ;
+50 ; FILE = FileMan number of the file (e.g. 2006.913)
+51 ; IENS = IEN of the record (e.g. "1," where 1 is an IEN)
+52 ; MFIELDID = Field number of the multiple field (e.g. 2)
+53 ;
+54 ; Return Values
+55 ; =============
+56 ; if error found during execution
+57 ; MAGRY(0) = "Failure status ^Error getting values"
+58 ; if success
+59 ; MAGRY(0) = Success status ^^Total lines
+60 ; MAGRY (1.n) = values in format
+61 ;
+62 ; e.g
+63 ; <KEYS>
+64 ; <KEY VALUE="" LEVEL=""/>
+65 ; ...
+66 ; <KEY VALUE="" LEVEL=""/>
+67 ; </KEYS>
+68 ;
+69 ; where
+70 ; KEY = the name of multiple field
+71 ; VALUE and LEVEL = field names in sub-file
+72 ;
GETMVAL(MAGRY,FILE,MFIELDID,IENS) ;
+1 NEW I,J,X
+2 NEW OUT,ERR,MAGRESA
+3 NEW FLDSARR,FLDSARRW,MFIELDNM,SUBFILE,FIELDS
+4 NEW CNT,QT,RESDEL
+5 SET QT=$CHAR(34)
+6 SET RESDEL=$$RESDEL^MAGVAF02()
+7 ; name of multiple field
SET MFIELDNM=$$GETFLDNM^MAGVAF01(FILE,MFIELDID)
+8 ; sub-file for the multiple fields
SET SUBFILE=$$GETSUBFL^MAGVAF01(FILE,MFIELDID)
+9 ; sub-file fields names
SET FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,SUBFILE,"I")
+10 SET FIELDS=MFIELDID_"*"
+11 IF IENS'=""
Begin DoDot:1
+12 DO GETS^DIQ(FILE,IENS,FIELDS,"","OUT","ERR")
+13 IF $DATA(ERR("DIERR"))
Begin DoDot:2
+14 DO MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
+15 ; Error getting the list
SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1)
QUIT
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
if $DATA(ERR("DIERR"))
QUIT
+18 ; Output the data
+19 ; IENs
SET I=""
+20 ; Fields in the sub-file
SET J=""
+21 SET CNT=0
+22 SET CNT=CNT+1
SET MAGRY(CNT)="<"_MFIELDNM_"S>"
+23 FOR
SET I=$ORDER(OUT(SUBFILE,I))
if I=""
QUIT
Begin DoDot:1
+24 SET CNT=CNT+1
SET MAGRY(CNT)="<"_MFIELDNM
+25 FOR
SET J=$ORDER(OUT(SUBFILE,I,J))
if J=""
QUIT
Begin DoDot:2
+26 ; the field is Date type - convert to IDF format
IF $$ISFLDDT^MAGVAF01(SUBFILE,J)
SET X=$$FM2IDF^MAGVAF01(OUT(SUBFILE,I,J))
+27 IF '$TEST
SET X=OUT(SUBFILE,I,J)
+28 SET MAGRY(CNT)=MAGRY(CNT)_" "_$TRANSLATE(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
+29 QUIT
End DoDot:2
+30 SET MAGRY(CNT)=MAGRY(CNT)_" />"
+31 QUIT
+32 SET CNT=CNT+1
SET MAGRY(CNT)="/>"
End DoDot:1
+33 SET CNT=CNT+1
SET MAGRY(CNT)="</"_MFIELDNM_"S>"
+34 SET MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
+35 QUIT
+36 ;
+37 ;
+38 ; **** Get a record from a file by "B" index value
+39 ; (in most of the cases it is value of .01 field) and return the result in XML format
+40 ;
+41 ; Input parameters
+42 ; ================
+43 ;
+44 ; FILE = FileMan number of the file (e.g. 2006.913)
+45 ; IENS = IEN in sub-file (e.g. "1," where 1 is an IEN)
+46 ; VAL = value in "B" index (in most of the cases it is value of .01 field)
+47 ; WPASLINE = 0 (WP value as it was stored) / 1 (WP value as a single line)
+48 ;
+49 ; Return Values
+50 ; =============
+51 ; if error found during execution
+52 ; MAGRY(0) = Failure status^Error getting values
+53 ; if success
+54 ; MAGRY(0) = Success status^^Total lines
+55 ; MAGRY (1.n) = values in XML format
+56 ;
GXMLBYID(MAGRY,FILE,IENS,VAL,WPASLINE) ;
+1 NEW FIELDS,FLDSARR,FLDSARRW,FILENM
+2 NEW OUT,ERR,MAGRESA,WP,WPTYPE
+3 NEW I,J,L,X,CNT
+4 NEW QT,RESDEL
+5 KILL MAGRY
+6 SET RESDEL=$$RESDEL^MAGVAF02()
+7 SET QT=$CHAR(34)
+8 ; File name without blank
SET FILENM=$TRANSLATE($$GETFILNM^MAGVAF01(FILE)," ")
+9 ; file fields names
SET FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"I")
+10 DO FIND^DIC(FILE,IENS,"@;"_FIELDS,"BQX",VAL,"","","","","OUT","ERR")
+11 IF $DATA(ERR("DIERR"))
Begin DoDot:1
+12 DO MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
+13 ; Error getting the list
SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1)
QUIT
+14 QUIT
End DoDot:1
QUIT
+15 ; Output the data
+16 SET CNT=0
+17 SET CNT=CNT+1
SET MAGRY(CNT)="<"_FILENM_"S>"
+18 ; IENs
SET I=""
+19 ; Fields in the file
SET J=""
+20 FOR
SET I=$ORDER(OUT("DILIST","ID",I))
if I=""
QUIT
Begin DoDot:1
+21 SET CNT=CNT+1
SET MAGRY(CNT)="<"_FILENM
+22 SET CNT=CNT+1
SET MAGRY(CNT)="PK="_QT_OUT("DILIST",2,I)_QT
+23 SET J=""
+24 FOR
SET J=$ORDER(OUT("DILIST","ID",I,J))
if J=""
QUIT
Begin DoDot:2
+25 SET X=OUT("DILIST","ID",I,J)
+26 ; the field is Date type - convert to IDF format
IF $$ISFLDDT^MAGVAF01(FILE,J)
SET X=$$FM2IDF^MAGVAF01(X)
+27 SET CNT=CNT+1
SET MAGRY(CNT)=$TRANSLATE(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
+28 QUIT
End DoDot:2
+29 ; Now get the Word-Processing fields
+30 SET J=""
+31 KILL WP
+32 FOR
SET J=$ORDER(FLDSARRW(J))
if J=""
QUIT
Begin DoDot:2
+33 IF $$ISFLDWP^MAGVAF01(.WPTYPE,FILE,J)
Begin DoDot:3
+34 SET X=$$GET1^DIQ(FILE,OUT("DILIST",2,I),J,"","WP")
+35 IF $DATA(WP)
Begin DoDot:4
+36 SET CNT=CNT+1
SET MAGRY(CNT)=$TRANSLATE(FLDSARRW(J)," /\<>&%")_"="_QT
+37 ; Get as a single line
IF WPASLINE
SET MAGRY(CNT)=MAGRY(CNT)_$$TRHTML^MAGVAF04($$STRWP^MAGVAF01(.WP))
+38 ; Get WP value as it was stored
IF '$TEST
Begin DoDot:5
+39 SET L=""
+40 FOR
SET L=$ORDER(WP(L))
if L=""
QUIT
Begin DoDot:6
+41 SET CNT=CNT+1
SET MAGRY(CNT)=$$TRHTML^MAGVAF04(WP(L))
+42 QUIT
End DoDot:6
+43 QUIT
End DoDot:5
+44 SET MAGRY(CNT)=MAGRY(CNT)_QT
+45 QUIT
End DoDot:4
+46 QUIT
End DoDot:3
QUIT
+47 QUIT
End DoDot:2
+48 SET MAGRY(CNT)=MAGRY(CNT)_" >"
+49 SET CNT=CNT+1
SET MAGRY(CNT)="</"_FILENM_" >"
+50 QUIT
End DoDot:1
+51 SET CNT=CNT+1
SET MAGRY(CNT)="</"_FILENM_"S>"
+52 SET MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
+53 QUIT
+54 ;
+55 ; Input Parameters
+56 ; ================
+57 ; MAGRY
+58 ; MAGRY(0)=1^^CNT
+59 ; MAGRY(3)=<FILENAME
+60 ; ...
+61 ; MAGRY(n)=</FILENAME>
+62 ;
+63 ; Output Values
+64 ; =============
+65 ;
+66 ; MAGRY(0)=1^^(CNT+1)
+67 ; MAGRY(1)="<?xml version=""1.0"" encoding=""utf-8""?>"
+68 ; MAGRY(2)=<FILENAMES>
+69 ; ....
+70 ; MAGRY(n+1)=</FILENAMES>
+71 ;
SETFTUCH(MAGRY) ; Set first two lines and the last one
+1 IF '$$ISOK^MAGVAF02(MAGRY(0))
QUIT
+2 ; Add first lines
+3 NEW RES,I
+4 SET MAGRY(1)=$$XML1LINE^MAGVAF02()
+5 SET MAGRY(2)=MAGRY(3)_"S>"
+6 SET I=$ORDER(MAGRY(""),-1)+1
+7 SET MAGRY(I)="</"_$PIECE(MAGRY(3),"<",2,999)_"S>"
+8 SET RES=MAGRY(0)
+9 DO SETVAL^MAGVAF02(.RES,I)
+10 SET MAGRY(0)=RES
+11 QUIT
+12 ;
+13 ;++++ Create an empty XML result by file number
+14 ; Input Parameters
+15 ; ================
+16 ; FILE - FileMan file number
+17 ;
+18 ; Return Values
+19 ; ==============
+20 ; MAGRY(0)=1^^3
+21 ; MAGRY(1)="<?xml version=""1.0"" encoding=""utf-8""?>"
+22 ; MAGRY(2)=<FILENAMES>
+23 ; MAGRY(3)=</FILENAMES>
+24 ;
+25 ; where FILENAME is the name of the file passed
+26 ;
EMPTYXML(MAGRY,FILE) ; Create an empty XML result by file number
+1 NEW FILENM
+2 ; File name without blank
SET FILENM=$TRANSLATE($$GETFILNM^MAGVAF01(FILE)," ")
+3 SET CNT=0
+4 SET MAGRY(0)=$$OK^MAGVAF02()_$$RESDEL^MAGVAF02()_$$RESDEL^MAGVAF02()_3
+5 SET MAGRY(1)=$$XML1LINE^MAGVAF02()
+6 SET MAGRY(2)="<"_FILENM_"S>"
+7 SET MAGRY(3)="</"_FILENM_"S>"
+8 QUIT
+9 ;
+10 ; **** Get a record from a file by IEN
+11 ; and return the result in XML format
+12 ;
+13 ; Input parameters
+14 ; ================
+15 ;
+16 ; FILE = FileMan number of the file (e.g. 2006.913)
+17 ; PK = IEN in the file
+18 ; WPASLINE = 0 (WP value as it was stored) / 1 (WP value as a single line)
+19 ;
+20 ; Return Values
+21 ; =============
+22 ; if error found during execution
+23 ; MAGRY(0) = Failure status^Error getting values
+24 ; if success
+25 ; MAGRY(0) = Success status^^Total lines
+26 ; MAGRY (1.n) = values in XML format
+27 ;
GXMLBYPK(MAGRY,FILE,PK,WPASLINE) ;
+1 NEW FIELDS,FLDSARR,FLDSARRW,FILENM
+2 NEW OUT,ERR,MAGRESA,WP,IENS
+3 NEW J,L,X,CNT,WPTYPE
+4 NEW QT,RESDEL
+5 KILL MAGRY
+6 SET RESDEL=$$RESDEL^MAGVAF02()
+7 SET QT=$CHAR(34)
+8 ; File name without blank
SET FILENM=$TRANSLATE($$GETFILNM^MAGVAF01(FILE)," ")
+9 ; file fields names
SET FIELDS=$$GETFLDS^MAGVAF01(.FLDSARR,.FLDSARRW,FILE,"")
+10 SET IENS=PK_","
+11 DO GETS^DIQ(FILE,PK_",",FIELDS,"I","OUT","ERR")
+12 IF $DATA(ERR("DIERR"))
Begin DoDot:1
+13 DO MSG^DIALOG("A",.MAGRESA,245,5,"ERR")
+14 ; Error getting the list
SET MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1)
QUIT
+15 QUIT
End DoDot:1
QUIT
+16 ; Output the data
+17 SET CNT=0
+18 ; Fields in the file
SET J=""
+19 SET CNT=CNT+1
SET MAGRY(CNT)="<"_FILENM
+20 SET CNT=CNT+1
SET MAGRY(CNT)="PK="_QT_PK_QT
+21 SET J=""
+22 FOR
SET J=$ORDER(OUT(FILE,IENS,J))
if J=""
QUIT
Begin DoDot:1
+23 SET X=OUT(FILE,IENS,J,"I")
+24 ; the field is Date type - convert to IDF format
IF $$ISFLDDT^MAGVAF01(FILE,J)
SET X=$$FM2IDF^MAGVAF01(X)
+25 SET CNT=CNT+1
SET MAGRY(CNT)=$TRANSLATE(FLDSARR(J)," /\<>&%")_"="_QT_X_QT
+26 QUIT
End DoDot:1
+27 ; Now get the Word-Processing fields
+28 SET J=""
+29 KILL WP
+30 FOR
SET J=$ORDER(FLDSARRW(J))
if J=""
QUIT
Begin DoDot:1
+31 IF $$ISFLDWP^MAGVAF01(.WPTYPE,FILE,J)
Begin DoDot:2
+32 SET X=$$GET1^DIQ(FILE,IENS,J,"","WP")
+33 IF $DATA(WP)
Begin DoDot:3
+34 SET CNT=CNT+1
SET MAGRY(CNT)=$TRANSLATE(FLDSARRW(J)," /\<>&%")_"="_QT
+35 ; Get as a single line
IF WPASLINE
SET MAGRY(CNT)=MAGRY(CNT)_$$TRHTML^MAGVAF04($$STRWP^MAGVAF01(.WP))
+36 ; Get WP value as it was stored
IF '$TEST
Begin DoDot:4
+37 SET L=""
+38 FOR
SET L=$ORDER(WP(L))
if L=""
QUIT
Begin DoDot:5
+39 SET CNT=CNT+1
SET MAGRY(CNT)=$$TRHTML^MAGVAF04(WP(L))
+40 QUIT
End DoDot:5
+41 QUIT
End DoDot:4
+42 SET MAGRY(CNT)=MAGRY(CNT)_QT
+43 QUIT
End DoDot:3
+44 QUIT
End DoDot:2
QUIT
+45 QUIT
End DoDot:1
+46 SET MAGRY(CNT)=MAGRY(CNT)_" >"
+47 SET CNT=CNT+1
SET MAGRY(CNT)="</"_FILENM_" >"
+48 SET MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_CNT
+49 QUIT
