HDISVS00 ;BPFO/JRP - PROCESS XML DOCS ON CENTRAL SERVER;1/4/2005
 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
 ;
MAIN(PRSARR,ERRARR) ;Main entry point for processing XML document
 ; Input : PRSARR - Array containing parsed XML document (closed root)
 ;                  This is the output of SAX^HDISVM01
 ;         ERRARR - Array to output errors in (closed root)
 ;Output : None
 ;         @ERRARR@(x) = Error text (if applicable)
 ; Notes : ERRARR is initialized (KILLed) on input
 N ROOT,TMP,OOPS,CODE,DESC
 ;Check input
 I $G(PRSARR)="" D  Q
 .S TMP="MAIN^HDISVS00: Input parameter PRSARR was not passed"
 .D ADDERR^HDISVC00(TMP,ERRARR)
 I '$D(@PRSARR) D  Q
 .S TMP="MAIN^HDISVS00: Input array "_PRSARR_" (PRSARR) does not exist"
 .D ADDERR^HDISVC00(TMP,ERRARR)
 ;Make sure data structure of parsed document exists
 S OOPS=0
 F X=1:1 S TMP=$P($T(SUBS+X),";;",2) Q:TMP=""  D
 .I $D(@PRSARR@(TMP)) Q
 .S TMP="MAIN^HDISVS00: Subscript "_TMP_" missing from input array "_PRSARR_" (PRSARR)"
 .D ADDERR^HDISVC00(TMP,ERRARR)
 .S OOPS=1
 I OOPS Q
 ;Get root element name
 S ROOT=$G(@PRSARR@("ESUBS",1))
 I ROOT="" D  Q
 .S TMP="Root element of XML document could not be determined"
 .D ADDERR^HDISVC00(TMP,ERRARR)
 ;Check for supported root element
 S OOPS=1
 F X=1:1 S TMP=$P($T(ROOTS+X),";;",2) Q:TMP=""  D  Q:'OOPS
 .I $P(TMP,"~",1)'=ROOT Q
 .S CODE=$P(TMP,"~",2)
 .S DESC=$P(TMP,"~",3)
 .S OOPS=0
 ;Unsupported root element
 I OOPS D  Q
 .S TMP="'"_ROOT_"' is not a supported root element (don't know how to process it)"
 .D ADDERR^HDISVC00(TMP,ERRARR)
 ;Code to process document not set
 I CODE="" D  Q
 .S TMP="Code to process root element '"_ROOT_"' has not been established"
 .D ADDERR^HDISVC00(TMP,ERRARR)
 ;Process XML document
 X CODE
 ;Done
 Q
 ;
SUBS ;Required subscripts in parse array (attributes aren't required)
 ;;EINDX
 ;;ESUBS
 ;;DATA
 ;;
 ;
ROOTS ;Root element name~Processing code for root element~Description
 ;;Domain~D VUID^HDISVS01(PRSARR,ERRARR)~Request for VUID data from VistA system
 ;;HDISParameters~D STATUS^HDISVS03(PRSARR,ERRARR)~Status update from VistA system
 ;;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVS00   2160     printed  Sep 23, 2025@19:33:07                                                                                                                                                                                                    Page 2
HDISVS00  ;BPFO/JRP - PROCESS XML DOCS ON CENTRAL SERVER;1/4/2005
 +1       ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
 +2       ;
MAIN(PRSARR,ERRARR) ;Main entry point for processing XML document
 +1       ; Input : PRSARR - Array containing parsed XML document (closed root)
 +2       ;                  This is the output of SAX^HDISVM01
 +3       ;         ERRARR - Array to output errors in (closed root)
 +4       ;Output : None
 +5       ;         @ERRARR@(x) = Error text (if applicable)
 +6       ; Notes : ERRARR is initialized (KILLed) on input
 +7        NEW ROOT,TMP,OOPS,CODE,DESC
 +8       ;Check input
 +9        IF $GET(PRSARR)=""
               Begin DoDot:1
 +10               SET TMP="MAIN^HDISVS00: Input parameter PRSARR was not passed"
 +11               DO ADDERR^HDISVC00(TMP,ERRARR)
               End DoDot:1
               QUIT 
 +12       IF '$DATA(@PRSARR)
               Begin DoDot:1
 +13               SET TMP="MAIN^HDISVS00: Input array "_PRSARR_" (PRSARR) does not exist"
 +14               DO ADDERR^HDISVC00(TMP,ERRARR)
               End DoDot:1
               QUIT 
 +15      ;Make sure data structure of parsed document exists
 +16       SET OOPS=0
 +17       FOR X=1:1
               SET TMP=$PIECE($TEXT(SUBS+X),";;",2)
               if TMP=""
                   QUIT 
               Begin DoDot:1
 +18               IF $DATA(@PRSARR@(TMP))
                       QUIT 
 +19               SET TMP="MAIN^HDISVS00: Subscript "_TMP_" missing from input array "_PRSARR_" (PRSARR)"
 +20               DO ADDERR^HDISVC00(TMP,ERRARR)
 +21               SET OOPS=1
               End DoDot:1
 +22       IF OOPS
               QUIT 
 +23      ;Get root element name
 +24       SET ROOT=$GET(@PRSARR@("ESUBS",1))
 +25       IF ROOT=""
               Begin DoDot:1
 +26               SET TMP="Root element of XML document could not be determined"
 +27               DO ADDERR^HDISVC00(TMP,ERRARR)
               End DoDot:1
               QUIT 
 +28      ;Check for supported root element
 +29       SET OOPS=1
 +30       FOR X=1:1
               SET TMP=$PIECE($TEXT(ROOTS+X),";;",2)
               if TMP=""
                   QUIT 
               Begin DoDot:1
 +31               IF $PIECE(TMP,"~",1)'=ROOT
                       QUIT 
 +32               SET CODE=$PIECE(TMP,"~",2)
 +33               SET DESC=$PIECE(TMP,"~",3)
 +34               SET OOPS=0
               End DoDot:1
               if 'OOPS
                   QUIT 
 +35      ;Unsupported root element
 +36       IF OOPS
               Begin DoDot:1
 +37               SET TMP="'"_ROOT_"' is not a supported root element (don't know how to process it)"
 +38               DO ADDERR^HDISVC00(TMP,ERRARR)
               End DoDot:1
               QUIT 
 +39      ;Code to process document not set
 +40       IF CODE=""
               Begin DoDot:1
 +41               SET TMP="Code to process root element '"_ROOT_"' has not been established"
 +42               DO ADDERR^HDISVC00(TMP,ERRARR)
               End DoDot:1
               QUIT 
 +43      ;Process XML document
 +44       XECUTE CODE
 +45      ;Done
 +46       QUIT 
 +47      ;
SUBS      ;Required subscripts in parse array (attributes aren't required)
 +1       ;;EINDX
 +2       ;;ESUBS
 +3       ;;DATA
 +4       ;;
 +5       ;
ROOTS     ;Root element name~Processing code for root element~Description
 +1       ;;Domain~D VUID^HDISVS01(PRSARR,ERRARR)~Request for VUID data from VistA system
 +2       ;;HDISParameters~D STATUS^HDISVS03(PRSARR,ERRARR)~Status update from VistA system
 +3       ;;