XHDTST.m

XHDTST ; SLC/JER - Test calls ; 25 Jul 2003  9:42 AM

 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003

INLST(ORY,ORX) ; Test input list

 N I,J,RC S I="",(J,RC)=0,ORY=$NA(^TMP("XHDZTST",$J))

 D XMLHDR^XHDLXM(.ORY,"result",.J),RSLTBL(.ORY,.J)

 F  S I=$O(ORX(I)) Q:I']""  D

 . N COL

 . S RC=RC+1

 . D BUILDROW(.COL,.ORX,I),SETROW(.ORY,.COL,.J)

 S SPEC("##")=RC,@ORY@(3)=$$REPLACE^XLFSTR(@ORY@(3),.SPEC)

 S J=J+1,@ORY@(J)="</rows>"

 S J=J+1,@ORY@(J)="</resultTable>"

 D XMLFOOT^XHDLXM(.ORY,"result",.J)

 Q

RSLTBL(ORY,ORI) ; resultTable

 S ORI=ORI+1

 S @ORY@(ORI)="<resultTable name=""test_list"" rowCount=""##"" columnCount=""2"">"

 S ORI=ORI+1,@ORY@(ORI)="<columns>"

 S ORI=ORI+1

 S @ORY@(ORI)="<c name=""name"" type=""string""/>"

 S ORI=ORI+1

 S @ORY@(ORI)="<c name=""value"" type=""string""/>"

 S ORI=ORI+1,@ORY@(ORI)="</columns>"

 S ORI=ORI+1,@ORY@(ORI)="<rows>"

 Q

BUILDROW(COL,ORX,I) ; Resolve fields for each row

 S COL(1)=I

 S COL(2)=ORX(I)

 Q

SETROW(ORY,COL,ORI) ; Generate tags for row

 N ORC,Y S ORC=0

 S ORI=ORI+1,@ORY@(ORI)="<r>"

 S Y=ORI

 F  S ORC=$O(COL(ORC)) Q:+ORC'>0  D

 . S ORI=ORI+1,@ORY@(ORI)=$S(COL(ORC)]"":"<c>"_COL(ORC)_"</c>",1:"<c/>")

 I Y=ORI S ORI=ORI+1,@ORY@(ORI)="<c/>"

 S ORI=ORI+1,@ORY@(ORI)="</r>"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XHDTST   1258     printed  Dec 13, 2024@01:57:22                                                                                                                                                                                                      Page 2

XHDTST    ; SLC/JER - Test calls ; 25 Jul 2003  9:42 AM

 +1       ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003

INLST(ORY,ORX) ; Test input list

 +1        NEW I,J,RC

           SET I=""

           SET (J,RC)=0

           SET ORY=$NAME(^TMP("XHDZTST",$JOB))

 +2        DO XMLHDR^XHDLXM(.ORY,"result",.J)

           DO RSLTBL(.ORY,.J)

 +3        FOR 

               SET I=$ORDER(ORX(I))

               if I']""

                   QUIT 

               Begin DoDot:1

 +4                NEW COL

 +5                SET RC=RC+1

 +6                DO BUILDROW(.COL,.ORX,I)

                   DO SETROW(.ORY,.COL,.J)

               End DoDot:1

 +7        SET SPEC("##")=RC

           SET @ORY@(3)=$$REPLACE^XLFSTR(@ORY@(3),.SPEC)

 +8        SET J=J+1

           SET @ORY@(J)="</rows>"

 +9        SET J=J+1

           SET @ORY@(J)="</resultTable>"

 +10       DO XMLFOOT^XHDLXM(.ORY,"result",.J)

 +11       QUIT 

RSLTBL(ORY,ORI) ; resultTable

 +1        SET ORI=ORI+1

 +2        SET @ORY@(ORI)="<resultTable name=""test_list"" rowCount=""##"" columnCount=""2"">"

 +3        SET ORI=ORI+1

           SET @ORY@(ORI)="<columns>"

 +4        SET ORI=ORI+1

 +5        SET @ORY@(ORI)="<c name=""name"" type=""string""/>"

 +6        SET ORI=ORI+1

 +7        SET @ORY@(ORI)="<c name=""value"" type=""string""/>"

 +8        SET ORI=ORI+1

           SET @ORY@(ORI)="</columns>"

 +9        SET ORI=ORI+1

           SET @ORY@(ORI)="<rows>"

 +10       QUIT 

BUILDROW(COL,ORX,I) ; Resolve fields for each row

 +1        SET COL(1)=I

 +2        SET COL(2)=ORX(I)

 +3        QUIT 

SETROW(ORY,COL,ORI) ; Generate tags for row

 +1        NEW ORC,Y

           SET ORC=0

 +2        SET ORI=ORI+1

           SET @ORY@(ORI)="<r>"

 +3        SET Y=ORI

 +4        FOR 

               SET ORC=$ORDER(COL(ORC))

               if +ORC'>0

                   QUIT 

               Begin DoDot:1

 +5                SET ORI=ORI+1

                   SET @ORY@(ORI)=$SELECT(COL(ORC)]"":"<c>"_COL(ORC)_"</c>",1:"<c/>")

               End DoDot:1

 +6        IF Y=ORI

               SET ORI=ORI+1

               SET @ORY@(ORI)="<c/>"

 +7        SET ORI=ORI+1

           SET @ORY@(ORI)="</r>"

 +8        QUIT