Ignore:
Timestamp:
Oct 13, 2012, 2:49:26 PM (12 years ago)
Author:
George Lilly
Message:

fix for lab units not found and C0STBL analysis routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • smart/trunk/p/C0SMXMLB.m

    r1569 r1571  
    1 MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09  16:55 - Smart Container Ver.
    2  ;;8.0;KERNEL;;;Build 2
    3  QUIT
    4  ;
    5  ;DOC - The top level tag
    6  ;DOCTYPE - Want to include a DOCTYPE node
    7  ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
    8 START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
    9  K ^TMP("MXMLBLD",$J)
    10  S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
    11  I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
    12  I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
    13  D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
    14  Q
    15  ;
    16 END ;Call this once to close out the document
    17  D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
    18  I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
    19  K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
    20  Q
    21  ;
    22 ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item
    23  N I,X
    24  S ATT=$G(ATT)
    25  I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
    26  D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">")
    27  Q
    28  ;DOITEM is a callback to output the lower level.
    29 MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule
    30  N I,X,S
    31  S ATT=$G(ATT)
    32  D PUSH($G(INDENT),TAG,.ATT)
    33  D @DOITEM
    34  D POP
    35  Q
    36  ;
    37 ATT(ATT) ;Output a string of attributes
    38  I $D(ATT)<9 Q ""
    39  N I,S,V
    40  S S="",I=""
    41  F  S I=$O(ATT(I)) Q:I=""  S S=S_" "_I_"="_$$Q(ATT(I))
    42  Q S
    43  ;
    44 Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
    45  ;I X'[$C(34) Q $C(34)_X_$C(34)
    46  I X'[$C(39) Q $C(39)_X_$C(39)
    47  ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
    48  N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
    49  F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
    50  S Y=Y_$P(X,Q,$L(X,Q))
    51  ;Q $C(34)_Y_$C(34)
    52  Q $C(39)_Y_$C(39)
    53  ;
    54 XMLHDR() ; -- provides current XML standard header
    55  Q "<?xml version=""1.0"" encoding=""utf-8"" ?>"
    56  ;
    57 OUTPUT(S) ;Output
    58  N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
    59  I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
    60  W S,!
    61  Q
    62  ;
    63 CHARCHK(STR) ; -- replace xml character limits with entities
    64  N A,I,X,Y,Z,NEWSTR
    65  S (Y,Z)=""
    66  ;IF STR["&" SET NEWSTR=STR DO  SET STR=Y_Z
    67  ;. FOR X=1:1  SET Y=Y_$PIECE(NEWSTR,"&",X)_"&amp;",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
    68  I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&amp;"_$P(STR,"&",I+1,999)
    69  I STR["<" F  S STR=$PIECE(STR,"<",1)_"&lt;"_$PIECE(STR,"<",2,99) Q:STR'["<"
    70  I STR[">" F  S STR=$PIECE(STR,">",1)_"&gt;"_$PIECE(STR,">",2,99) Q:STR'[">"
    71  I STR["'" F  S STR=$PIECE(STR,"'",1)_"&apos;"_$PIECE(STR,"'",2,99) Q:STR'["'"
    72  I STR["""" F  S STR=$PIECE(STR,"""",1)_"&quot;"_$PIECE(STR,"""",2,99) Q:STR'[""""
    73  ;
    74  S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
    75  QUIT STR
    76  ;
    77 COMMENT(VAL) ;Add Comments
    78  N I,L
    79  ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q
    80  I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q  ;CHANGED BY GPL FOR GTM
    81  S I="",L="<!--"
    82  F  S I=$O(ATT(I)) Q:I=""  D OUTPUT(L_ATT(I)) S L=""
    83  D OUTPUT("-->")
    84  Q
    85  ;
    86 PUSH(INDENT,TAG,ATT) ;Write a TAG and save.
    87  N CNT
    88  S ATT=$G(ATT)
    89  D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
    90  S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG
    91  Q
    92  ;
    93 POP ;Write last pushed tag and pop
    94  N CNT,TAG,INDENT,X
    95  S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1
    96  S INDENT=+X,TAG=$P(X,"^",2)
    97  D OUTPUT($$BLS(INDENT)_"</"_TAG_">")
    98  Q
    99  ;
    100 BLS(I) ;Return INDENT string
    101  N S
    102  S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
    103  Q S
    104  ;
    105 INDENT() ;Renturn indent level
    106  Q +$G(^TMP("MXMLBLD",$J,"STK"))
     1MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09  16:55 - Smart Container Ver.
     2        ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
     3        QUIT
     4        ;
     5        ;DOC - The top level tag
     6        ;DOCTYPE - Want to include a DOCTYPE node
     7        ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
     8START(DOC,DOCTYPE,FLAG,NO1ST)   ;Call this once at the begining.
     9        K ^TMP("MXMLBLD",$J)
     10        S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
     11        I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
     12        I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
     13        D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
     14        Q
     15        ;
     16END     ;Call this once to close out the document
     17        D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
     18        I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
     19        K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
     20        Q
     21        ;
     22ITEM(INDENT,TAG,ATT,VALUE)      ;Output a Item
     23        N I,X
     24        S ATT=$G(ATT)
     25        I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
     26        D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">")
     27        Q
     28        ;DOITEM is a callback to output the lower level.
     29MULTI(INDENT,TAG,ATT,DOITEM)    ;Output a Multipule
     30        N I,X,S
     31        S ATT=$G(ATT)
     32        D PUSH($G(INDENT),TAG,.ATT)
     33        D @DOITEM
     34        D POP
     35        Q
     36        ;
     37ATT(ATT)        ;Output a string of attributes
     38        I $D(ATT)<9 Q ""
     39        N I,S,V
     40        S S="",I=""
     41        F  S I=$O(ATT(I)) Q:I=""  S S=S_" "_I_"="_$$Q(ATT(I))
     42        Q S
     43        ;
     44Q(X)    ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
     45        ;I X'[$C(34) Q $C(34)_X_$C(34)
     46        I X'[$C(39) Q $C(39)_X_$C(39)
     47        ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
     48        N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
     49        F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
     50        S Y=Y_$P(X,Q,$L(X,Q))
     51        ;Q $C(34)_Y_$C(34)
     52        Q $C(39)_Y_$C(39)
     53        ;
     54XMLHDR()        ; -- provides current XML standard header
     55        Q "<?xml version=""1.0"" encoding=""utf-8"" ?>"
     56        ;
     57OUTPUT(S)       ;Output
     58        N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
     59        I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
     60        W S,!
     61        Q
     62        ;
     63CHARCHK(STR)    ; -- replace xml character limits with entities
     64        N A,I,X,Y,Z,NEWSTR
     65        S (Y,Z)=""
     66        ;IF STR["&" SET NEWSTR=STR DO  SET STR=Y_Z
     67        ;. FOR X=1:1  SET Y=Y_$PIECE(NEWSTR,"&",X)_"&amp;",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
     68        I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&amp;"_$P(STR,"&",I+1,999)
     69        I STR["<" F  S STR=$PIECE(STR,"<",1)_"&lt;"_$PIECE(STR,"<",2,99) Q:STR'["<"
     70        I STR[">" F  S STR=$PIECE(STR,">",1)_"&gt;"_$PIECE(STR,">",2,99) Q:STR'[">"
     71        I STR["'" F  S STR=$PIECE(STR,"'",1)_"&apos;"_$PIECE(STR,"'",2,99) Q:STR'["'"
     72        I STR["""" F  S STR=$PIECE(STR,"""",1)_"&quot;"_$PIECE(STR,"""",2,99) Q:STR'[""""
     73        ;
     74        S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
     75        QUIT STR
     76        ;
     77COMMENT(VAL)    ;Add Comments
     78        N I,L
     79        ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q
     80        I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q  ;CHANGED BY GPL FOR GTM
     81        S I="",L="<!--"
     82        F  S I=$O(ATT(I)) Q:I=""  D OUTPUT(L_ATT(I)) S L=""
     83        D OUTPUT("-->")
     84        Q
     85        ;
     86PUSH(INDENT,TAG,ATT)    ;Write a TAG and save.
     87        N CNT
     88        S ATT=$G(ATT)
     89        D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
     90        S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG
     91        Q
     92        ;
     93POP     ;Write last pushed tag and pop
     94        N CNT,TAG,INDENT,X
     95        S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1
     96        S INDENT=+X,TAG=$P(X,"^",2)
     97        D OUTPUT($$BLS(INDENT)_"</"_TAG_">")
     98        Q
     99        ;
     100BLS(I)  ;Return INDENT string
     101        N S
     102        S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
     103        Q S
     104        ;
     105INDENT()        ;Renturn indent level
     106        Q +$G(^TMP("MXMLBLD",$J,"STK"))
Note: See TracChangeset for help on using the changeset viewer.