- HDISXML ; CT/GRR - XML UTILITY ROUTINE; 16-FEB-2004 ; 02 Mar 2005 4:17 PM
- ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
- ;
- XMLOUT(HDISTEMP,HDISE,HDISF,HDIST,HDISERR) ;
- ;;Input Parameters (all required)
- ;;
- ;;HDISTEMP - IEN of XML Template
- ;;
- ;;HDISE - Element Number(s), separated by a comma, to be formatted
- ;; and moved to the output array
- ;;
- ;;HDISF - Reference of the input array
- ;;
- ;;HDIST - Reference of the target array
- ;;
- ;;HDISERR - reference of error variable
- ;;
- ;;
- I HDISTEMP=""!(HDISE="")!(HDISF="")!(HDIST="") S @HDISERR="Missing Input Parameter",HDISOK=0 G XMLOUTQ
- N BLANK,CLOSE,DA,ELEV,HASKID,HDENT,HDISFE,HDISFO,HDISFT,HDISOK,IEN,IND,ISMULTI,LASTIEN,LINE,OPEN,QUOTE,REQ,TEXTIN,TRANSTXT,Y,ENAME
- S:HDISE'["," HDISE=HDISE_","
- D INIT
- F I=1:1 S E=$P(HDISE,",",I) Q:E="" D
- .S (HDISFT,HDISFE)=$NA(@HDISF@(E))
- .I E["/" S E=$P(E,"/",1) D CLOSE(HDISTEMP,E,HDISF,HDIST,.HDERR) Q
- .D PROCESS(E)
- XMLOUTQ Q
- ;
- GETED(E) ;
- S IEN=$O(^HDIS(7115.3,HDISTEMP,"SEQ","B",E,0))
- S Y(0)=$G(^HDIS(7115.3,HDISTEMP,"SEQ",IEN,0))
- S REQ=$P(Y(0),"^",3),ENAME=$P(Y(0),"^",2),ELEV=$P(Y(0),"^",5),HASKID=$P(Y(0),"^",6),ISMULTI=$P(Y(0),"^",7)
- Q
- ;
- PROCESS(E) ;
- D GETED(E)
- I 'ISMULTI D FORMAT Q
- S DA=0 F S DA=$O(@HDISFE@(DA)) Q:DA'>0 S HDISF=$NA(@HDISFE@(DA)) D FORMAT
- Q
- INIT ;
- ;N OPEN,CLOSE,QUOTE,IND,REQ,BLANK
- S OPEN="<",CLOSE=">",QUOTE="""",BLANK=" ",$P(BLANK," ",100)=" "
- S IND=$P(^HDIS(7115.3,HDISTEMP,0),"^",5)
- S LASTIEN=$O(@HDIST@(9999999),-1)
- S HDISOK=1,HDISFO=HDISF
- Q
- ;
- FORMAT ;
- I 'HASKID S TEXTIN=@HDISFE Q:TEXTIN=""&'(REQ) S TRANSTXT=$$TRANSLAT(TEXTIN)
- S LINE=""
- S LINE=$E(BLANK,1,(IND*ELEV))_OPEN_ENAME_CLOSE
- I 'HASKID S LINE=LINE_TRANSTXT_OPEN_"/"_ENAME_CLOSE
- S LASTIEN=LASTIEN+1
- S @HDIST@(LASTIEN)=LINE
- Q
- ;
- CLOSE(HDISTEMP,HDISE,HDISF,HDIST,HDERR) ;
- D INIT
- D GETED(HDISE)
- S LINE=""
- S LINE=$E(BLANK,1,(IND*ELEV))_OPEN_"/"_ENAME_CLOSE
- S LASTIEN=LASTIEN+1
- S @HDIST@(LASTIEN)=LINE
- Q
- ;
- TRANSLAT(X) ;
- N HDPAT,I
- I X["&" F I=1:1 Q:I=$L(X) I $E(X,I)="&" S X=$E(X,1,(I-1))_"&"_$E(X,I+1,$L(X))
- F HDPAT="'","""",">","<" F Q:X'[HDPAT D
- .S HDENT=""
- .I HDPAT="'" S HDENT="'"
- .I HDPAT="""" S HDENT="""
- .I HDPAT=">" S HDENT=">"
- .I HDPAT="<" S HDENT="<"
- .Q:HDENT=""
- .S X=$P(X,HDPAT,1)_HDENT_$P(X,HDPAT,2,99)
- Q X
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISXML 2365 printed Feb 18, 2025@23:23:29 Page 2
- HDISXML ; CT/GRR - XML UTILITY ROUTINE; 16-FEB-2004 ; 02 Mar 2005 4:17 PM
- +1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
- +2 ;
- XMLOUT(HDISTEMP,HDISE,HDISF,HDIST,HDISERR) ;
- +1 ;;Input Parameters (all required)
- +2 ;;
- +3 ;;HDISTEMP - IEN of XML Template
- +4 ;;
- +5 ;;HDISE - Element Number(s), separated by a comma, to be formatted
- +6 ;; and moved to the output array
- +7 ;;
- +8 ;;HDISF - Reference of the input array
- +9 ;;
- +10 ;;HDIST - Reference of the target array
- +11 ;;
- +12 ;;HDISERR - reference of error variable
- +13 ;;
- +14 ;;
- +15 IF HDISTEMP=""!(HDISE="")!(HDISF="")!(HDIST="")
- SET @HDISERR="Missing Input Parameter"
- SET HDISOK=0
- GOTO XMLOUTQ
- +16 NEW BLANK,CLOSE,DA,ELEV,HASKID,HDENT,HDISFE,HDISFO,HDISFT,HDISOK,IEN,IND,ISMULTI,LASTIEN,LINE,OPEN,QUOTE,REQ,TEXTIN,TRANSTXT,Y,ENAME
- +17 if HDISE'[","
- SET HDISE=HDISE_","
- +18 DO INIT
- +19 FOR I=1:1
- SET E=$PIECE(HDISE,",",I)
- if E=""
- QUIT
- Begin DoDot:1
- +20 SET (HDISFT,HDISFE)=$NAME(@HDISF@(E))
- +21 IF E["/"
- SET E=$PIECE(E,"/",1)
- DO CLOSE(HDISTEMP,E,HDISF,HDIST,.HDERR)
- QUIT
- +22 DO PROCESS(E)
- End DoDot:1
- XMLOUTQ QUIT
- +1 ;
- GETED(E) ;
- +1 SET IEN=$ORDER(^HDIS(7115.3,HDISTEMP,"SEQ","B",E,0))
- +2 SET Y(0)=$GET(^HDIS(7115.3,HDISTEMP,"SEQ",IEN,0))
- +3 SET REQ=$PIECE(Y(0),"^",3)
- SET ENAME=$PIECE(Y(0),"^",2)
- SET ELEV=$PIECE(Y(0),"^",5)
- SET HASKID=$PIECE(Y(0),"^",6)
- SET ISMULTI=$PIECE(Y(0),"^",7)
- +4 QUIT
- +5 ;
- PROCESS(E) ;
- +1 DO GETED(E)
- +2 IF 'ISMULTI
- DO FORMAT
- QUIT
- +3 SET DA=0
- FOR
- SET DA=$ORDER(@HDISFE@(DA))
- if DA'>0
- QUIT
- SET HDISF=$NAME(@HDISFE@(DA))
- DO FORMAT
- +4 QUIT
- INIT ;
- +1 ;N OPEN,CLOSE,QUOTE,IND,REQ,BLANK
- +2 SET OPEN="<"
- SET CLOSE=">"
- SET QUOTE=""""
- SET BLANK=" "
- SET $PIECE(BLANK," ",100)=" "
- +3 SET IND=$PIECE(^HDIS(7115.3,HDISTEMP,0),"^",5)
- +4 SET LASTIEN=$ORDER(@HDIST@(9999999),-1)
- +5 SET HDISOK=1
- SET HDISFO=HDISF
- +6 QUIT
- +7 ;
- FORMAT ;
- +1 IF 'HASKID
- SET TEXTIN=@HDISFE
- if TEXTIN=""&'(REQ)
- QUIT
- SET TRANSTXT=$$TRANSLAT(TEXTIN)
- +2 SET LINE=""
- +3 SET LINE=$EXTRACT(BLANK,1,(IND*ELEV))_OPEN_ENAME_CLOSE
- +4 IF 'HASKID
- SET LINE=LINE_TRANSTXT_OPEN_"/"_ENAME_CLOSE
- +5 SET LASTIEN=LASTIEN+1
- +6 SET @HDIST@(LASTIEN)=LINE
- +7 QUIT
- +8 ;
- CLOSE(HDISTEMP,HDISE,HDISF,HDIST,HDERR) ;
- +1 DO INIT
- +2 DO GETED(HDISE)
- +3 SET LINE=""
- +4 SET LINE=$EXTRACT(BLANK,1,(IND*ELEV))_OPEN_"/"_ENAME_CLOSE
- +5 SET LASTIEN=LASTIEN+1
- +6 SET @HDIST@(LASTIEN)=LINE
- +7 QUIT
- +8 ;
- TRANSLAT(X) ;
- +1 NEW HDPAT,I
- +2 IF X["&"
- FOR I=1:1
- if I=$LENGTH(X)
- QUIT
- IF $EXTRACT(X,I)="&"
- SET X=$EXTRACT(X,1,(I-1))_"&"_$EXTRACT(X,I+1,$LENGTH(X))
- +3 FOR HDPAT="'","""",">","<"
- FOR
- if X'[HDPAT
- QUIT
- Begin DoDot:1
- +4 SET HDENT=""
- +5 IF HDPAT="'"
- SET HDENT="'"
- +6 IF HDPAT=""""
- SET HDENT="""
- +7 IF HDPAT=">"
- SET HDENT=">"
- +8 IF HDPAT="<"
- SET HDENT="<"
- +9 if HDENT=""
- QUIT
- +10 SET X=$PIECE(X,HDPAT,1)_HDENT_$PIECE(X,HDPAT,2,99)
- End DoDot:1
- +11 QUIT X
- +12 ;