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 Jan 18, 2025@02:58:20 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 ;
