VPRHST1.m

VPRHST1 ;SLC/KCM,MKB - Display XML object ;09/18/18 4:36pm

 ;;1.0;VIRTUAL PATIENT RECORD;**8,25,27**;Sep 01, 2011;Build 10

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

XML(OBJ) ; -- display XML OBJect in hierarchy, returns DONE if ^

 N XSTRING,ORSTK,ORNXT,ORCNT K DONE,QUIT

 S XSTRING=$G(OBJ) Q:'$L(XSTRING)

 S ORSTK=-1,ORCNT=0 D OPEN

 ;

 F  S ORNXT=$E(XSTRING,1,2) D @$S(ORNXT="</":"CLOSE",ORNXT?1"<"1.A.E:"OPEN",1:"XDATA") Q:XSTRING=""  Q:$G(DONE)

 Q

 ;

OPEN ; -- opening tag

 N TAG S TAG=$P(XSTRING,">")_">",XSTRING=$E(XSTRING,$L(TAG)+1,999999999)

 S ORCNT=ORCNT+1 I ORCNT>(IOSL-4) D READ Q:$G(DONE)  S ORCNT=1

 S ORSTK=ORSTK+1 W !,?((ORSTK*2)),TAG

 Q

 ;

XDATA ; -- data + closing tag

 N DATA,TAG

 S DATA=$P(XSTRING,"</") W DATA

 S XSTRING=$E(XSTRING,$L(DATA)+1,999999999)

 S TAG=$P(XSTRING,">")_">" W TAG

 S XSTRING=$E(XSTRING,$L(TAG)+1,999999999),ORSTK=ORSTK-1

 Q

 ;

CLOSE ; -- closing tag, pop stack

 N TAG S TAG=$P(XSTRING,">")_">",XSTRING=$E(XSTRING,$L(TAG)+1,999999999)

 S ORCNT=ORCNT+1 I ORCNT>(IOSL-4) D READ Q:$G(DONE)  S ORCNT=1

 W !,?((ORSTK*2)),TAG S ORSTK=ORSTK-1

 Q

 ;

READ ; -- continue?

 N X K DONE,QUIT

R1 W !!,"Press <return> to continue or ^ to exit item ..." R X:DTIME

 I X["?" W !,"Enter ^ to skip the rest of this item, or ^^ to exit the option." G R1

 S:X["^" DONE=1 S:X["^^" QUIT=1

 Q

 ;

JSON(OBJ) ; -- display JSON OBJect in hierarchy, returns DONE if ^

 N XSTRING,ORSTK,ORNXT,ORCNT

 S XSTRING=$G(OBJ) Q:'$L(XSTRING)

 S ORSTK=-1,ORCNT=0

 ;

 F  D TAG S ORNXT=$E(XSTRING) D @$S(ORNXT="{":"BRACE",ORNXT="[":"LIST",1:"JDATA") Q:XSTRING=""  Q:$G(DONE)

 Q

 ;

TAG ; -- display tag

 N TAG S TAG=$P(XSTRING,":")_":",XSTRING=$E(XSTRING,$L(TAG)+1,999999999)

 S ORCNT=ORCNT+1 I ORCNT>(IOSL-4) D READ Q:$G(DONE)  S ORCNT=1

 S ORSTK=ORSTK+1 W !,?((ORSTK*2)),TAG

 Q

 ;

BRACE ; -- braces

 W "{"

 S XSTRING=$E(XSTRING,2,999999999)

 Q

 ;

LIST ; -- list

 W "["

 S XSTRING=$E(XSTRING,2,999999999)

 ; ??

 Q

 ;

JDATA ; -- display value, pop stack

 N X,I S X=$P(XSTRING,", ")

 S:$E(XSTRING,$L(X)+1,$L(X)+2)=", " X=X_", "

 S XSTRING=$E(XSTRING,$L(X)+1,999999999)

 W X S ORSTK=ORSTK-1

 ; pop stack one more time for every closing brace

 F I=1:1:$L(X) I $E(X,I)="}" S ORSTK=ORSTK-1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPRHST1   2280     printed  Feb 19, 2025@00:11:44                                                                                                                                                                                                     Page 2

VPRHST1   ;SLC/KCM,MKB - Display XML object ;09/18/18 4:36pm

 +1       ;;1.0;VIRTUAL PATIENT RECORD;**8,25,27**;Sep 01, 2011;Build 10

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

XML(OBJ)  ; -- display XML OBJect in hierarchy, returns DONE if ^

 +1        NEW XSTRING,ORSTK,ORNXT,ORCNT

           KILL DONE,QUIT

 +2        SET XSTRING=$GET(OBJ)

           if '$LENGTH(XSTRING)

               QUIT 

 +3        SET ORSTK=-1

           SET ORCNT=0

           DO OPEN

 +4       ;

 +5        FOR 

               SET ORNXT=$EXTRACT(XSTRING,1,2)

               DO @$SELECT(ORNXT="</":"CLOSE",ORNXT?1"<"1.A.E:"OPEN",1:"XDATA")

               if XSTRING=""

                   QUIT 

               if $GET(DONE)

                   QUIT 

 +6        QUIT 

 +7       ;

OPEN      ; -- opening tag

 +1        NEW TAG

           SET TAG=$PIECE(XSTRING,">")_">"

           SET XSTRING=$EXTRACT(XSTRING,$LENGTH(TAG)+1,999999999)

 +2        SET ORCNT=ORCNT+1

           IF ORCNT>(IOSL-4)

               DO READ

               if $GET(DONE)

                   QUIT 

               SET ORCNT=1

 +3        SET ORSTK=ORSTK+1

           WRITE !,?((ORSTK*2)),TAG

 +4        QUIT 

 +5       ;

XDATA     ; -- data + closing tag

 +1        NEW DATA,TAG

 +2        SET DATA=$PIECE(XSTRING,"</")

           WRITE DATA

 +3        SET XSTRING=$EXTRACT(XSTRING,$LENGTH(DATA)+1,999999999)

 +4        SET TAG=$PIECE(XSTRING,">")_">"

           WRITE TAG

 +5        SET XSTRING=$EXTRACT(XSTRING,$LENGTH(TAG)+1,999999999)

           SET ORSTK=ORSTK-1

 +6        QUIT 

 +7       ;

CLOSE     ; -- closing tag, pop stack

 +1        NEW TAG

           SET TAG=$PIECE(XSTRING,">")_">"

           SET XSTRING=$EXTRACT(XSTRING,$LENGTH(TAG)+1,999999999)

 +2        SET ORCNT=ORCNT+1

           IF ORCNT>(IOSL-4)

               DO READ

               if $GET(DONE)

                   QUIT 

               SET ORCNT=1

 +3        WRITE !,?((ORSTK*2)),TAG

           SET ORSTK=ORSTK-1

 +4        QUIT 

 +5       ;

READ      ; -- continue?

 +1        NEW X

           KILL DONE,QUIT

R1         WRITE !!,"Press <return> to continue or ^ to exit item ..."

           READ X:DTIME

 +1        IF X["?"

               WRITE !,"Enter ^ to skip the rest of this item, or ^^ to exit the option."

               GOTO R1

 +2        if X["^"

               SET DONE=1

           if X["^^"

               SET QUIT=1

 +3        QUIT 

 +4       ;

JSON(OBJ) ; -- display JSON OBJect in hierarchy, returns DONE if ^

 +1        NEW XSTRING,ORSTK,ORNXT,ORCNT

 +2        SET XSTRING=$GET(OBJ)

           if '$LENGTH(XSTRING)

               QUIT 

 +3        SET ORSTK=-1

           SET ORCNT=0

 +4       ;

 +5        FOR 

               DO TAG

               SET ORNXT=$EXTRACT(XSTRING)

               DO @$SELECT(ORNXT="{":"BRACE",ORNXT="[":"LIST",1:"JDATA")

               if XSTRING=""

                   QUIT 

               if $GET(DONE)

                   QUIT 

 +6        QUIT 

 +7       ;

TAG       ; -- display tag

 +1        NEW TAG

           SET TAG=$PIECE(XSTRING,":")_":"

           SET XSTRING=$EXTRACT(XSTRING,$LENGTH(TAG)+1,999999999)

 +2        SET ORCNT=ORCNT+1

           IF ORCNT>(IOSL-4)

               DO READ

               if $GET(DONE)

                   QUIT 

               SET ORCNT=1

 +3        SET ORSTK=ORSTK+1

           WRITE !,?((ORSTK*2)),TAG

 +4        QUIT 

 +5       ;

BRACE     ; -- braces

 +1        WRITE "{"

 +2        SET XSTRING=$EXTRACT(XSTRING,2,999999999)

 +3        QUIT 

 +4       ;

LIST      ; -- list

 +1        WRITE "["

 +2        SET XSTRING=$EXTRACT(XSTRING,2,999999999)

 +3       ; ??

 +4        QUIT 

 +5       ;

JDATA     ; -- display value, pop stack

 +1        NEW X,I

           SET X=$PIECE(XSTRING,", ")

 +2        if $EXTRACT(XSTRING,$LENGTH(X)+1,$LENGTH(X)+2)=", "

               SET X=X_", "

 +3        SET XSTRING=$EXTRACT(XSTRING,$LENGTH(X)+1,999999999)

 +4        WRITE X

           SET ORSTK=ORSTK-1

 +5       ; pop stack one more time for every closing brace

 +6        FOR I=1:1:$LENGTH(X)

               IF $EXTRACT(X,I)="}"

                   SET ORSTK=ORSTK-1

 +7        QUIT