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