- HDISVC00 ;BPFO/JRP - PROCESS XML DOCS ON VISTA SYSTEM;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^HDISVC00: Input parameter PRSARR was not passed"
- .D ADDERR(TMP,ERRARR)
- I '$D(@PRSARR) D Q
- .S TMP="MAIN^HDISVC00: Input array "_PRSARR_" (PRSARR) does not exist"
- .D ADDERR(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^HDISVC00: Subscript "_TMP_" missing from input array "_PRSARR_" (PRSARR)"
- .D ADDERR(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(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(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(TMP,ERRARR)
- ;Process XML document
- X CODE
- ;Done
- Q
- ;
- ADDERR(TXT,ERRARR) ;Add to list of errors
- ; Input : TXT - Error text
- ; ERRARR - Error array (closed root)
- ;Output : None
- ; @ERRARR@(x) = Error text
- ; Notes : Existance/validity of input assumed (internal call)
- N X
- I $G(ERRARR)="" Q
- S X=1+$O(@ERRARR@(""),-1)
- S @ERRARR@(X)=$G(TXT)
- 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 DOMAIN^HDISVC01(PRSARR,ERRARR)~VUID data from centralized VUID Server
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVC00 2344 printed Jan 18, 2025@02:57:52 Page 2
- HDISVC00 ;BPFO/JRP - PROCESS XML DOCS ON VISTA SYSTEM;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^HDISVC00: Input parameter PRSARR was not passed"
- +11 DO ADDERR(TMP,ERRARR)
- End DoDot:1
- QUIT
- +12 IF '$DATA(@PRSARR)
- Begin DoDot:1
- +13 SET TMP="MAIN^HDISVC00: Input array "_PRSARR_" (PRSARR) does not exist"
- +14 DO ADDERR(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^HDISVC00: Subscript "_TMP_" missing from input array "_PRSARR_" (PRSARR)"
- +20 DO ADDERR(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(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(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(TMP,ERRARR)
- End DoDot:1
- QUIT
- +43 ;Process XML document
- +44 XECUTE CODE
- +45 ;Done
- +46 QUIT
- +47 ;
- ADDERR(TXT,ERRARR) ;Add to list of errors
- +1 ; Input : TXT - Error text
- +2 ; ERRARR - Error array (closed root)
- +3 ;Output : None
- +4 ; @ERRARR@(x) = Error text
- +5 ; Notes : Existance/validity of input assumed (internal call)
- +6 NEW X
- +7 IF $GET(ERRARR)=""
- QUIT
- +8 SET X=1+$ORDER(@ERRARR@(""),-1)
- +9 SET @ERRARR@(X)=$GET(TXT)
- +10 QUIT
- +11 ;
- 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 DOMAIN^HDISVC01(PRSARR,ERRARR)~VUID data from centralized VUID Server
- +2 ;;