XHDPDEF ; SLC/JER - Parameter Definition Calls ; 25 Jul 2003 9:42 AM
;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
LIST(XHDY,FROM,DIR,SIZE) ; Get next SIZE definitions in DIR direction
N XHDI,XHDCNT S XHDCNT=0,SIZE=$G(SIZE,44),DIR=$G(DIR,"+1")
S XHDI=FROM ;$S(FROM="":FROM,1:$O(^XTV(8989.51,"B",FROM),-DIR))
F S XHDI=$O(^XTV(8989.51,"B",XHDI),DIR) Q:XHDI']""!(XHDCNT'<SIZE) D
. N XHDDA S XHDDA=0
. F S XHDDA=$O(^XTV(8989.51,"B",XHDI,XHDDA)) Q:+XHDDA'>0!(XHDCNT'<SIZE) D
. . S XHDCNT=XHDCNT+1,XHDY(XHDCNT)=XHDDA_U_$P($G(^XTV(8989.51,+XHDDA,0)),U,1,2)_U_$$ENTSTR(XHDDA)
Q
GETALL(XHDY) ; Gets all parameter definitions in ^TMP("XHDPDEF",$J)
N XHDI,XHDCNT S XHDI="",XHDCNT=0 S XHDY=$NA(^TMP("XHDPDEF",$J))
F S XHDI=$O(^XTV(8989.51,"B",XHDI)) Q:XHDI']"" D
. N XHDDA S XHDDA=0
. F S XHDDA=$O(^XTV(8989.51,"B",XHDI,XHDDA)) Q:+XHDDA'>0 D
. . S XHDCNT=XHDCNT+1
. . S @XHDY@(XHDCNT)=XHDDA_U_$P($G(^XTV(8989.51,XHDDA,0)),U,1,2)_U_$$ENTSTR(XHDDA)
Q
ENTSTR(XHDDA) ; Get applicable entities
N XHDI,ENTSTR,ENTCNT S ENTSTR="",(ENTCNT,XHDI)=0
F S XHDI=$O(^XTV(8989.51,XHDDA,30,XHDI)) Q:XHDI'>0 D
. N ENT0 S ENT0=$G(^XTV(8989.51,XHDDA,30,XHDI,0)) Q:+ENT0'>0
. S ENTSTR=ENTSTR_$S(ENTCNT=0:"",1:";")_+ENT0_"|"_$$ENTFILE($P(ENT0,U,2))
. S ENTCNT=ENTCNT+1
Q ENTSTR
ENTFILE(ENTDA) ; Resolve entity name
Q $P($G(^XTV(8989.518,ENTDA,0)),U)
GETXML(XHDY,XHDDA) ; Control Branching
N XHDI,XHDJ,X S X="ONERROR^XHDPDEF",@^%ZOSF("TRAP")
S XHDI=0,XHDJ=""
S XHDY=$NA(^TMP("XHDPDEF",$J)) K @XHDY
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<?xml version=""1.0"" encoding=""UTF-8""?>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<getParameterDefinitionsCallResult>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<parameterDefinitionList>"
I +$G(XHDDA) D
. D GETDEF(XHDY,XHDDA,.XHDI)
E D
. F S XHDJ=$O(^XTV(8989.51,"B",XHDJ)) Q:XHDJ="" D
. . N XHDDA S XHDDA=0
. . F S XHDDA=$O(^XTV(8989.51,"B",XHDJ,XHDDA)) Q:+XHDDA'>0 D
. . . D GETDEF(XHDY,XHDDA,.XHDI)
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</parameterDefinitionList>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</getParameterDefinitionsCallResult>"
S XHDY=$NA(^TMP("XHDPDEF",$J,"XMLDOC"))
M ^XTMP("XHDPDEF",$J,"XMLDOC")=@XHDY
Q
FLDS() ; Get field string
Q ".01:8"
GETDEF(XHDY,XHDDA,XHDI) ; Loads Top-level Fields
N XHDF,XHDDI S XHDF=0
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<parameterDefinition>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<id>"_XHDDA_"</id>"
D GETS^DIQ(8989.51,XHDDA_",",$$FLDS,"E",XHDY)
F S XHDF=$O(@XHDY@(8989.51,XHDDA_",",XHDF)) Q:XHDF'>0 D
. N TAG,VAL
. S TAG=$TR($$FLDNAME(XHDF,8989.51)," /","")
. S VAL=$G(@XHDY@(8989.51,XHDDA_",",XHDF,"E"))
. I $S(XHDF=.03:1,XHDF=.06:1,1:0) S VAL=$S(VAL="Yes":"true",1:"false")
. S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<"_TAG_">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">"
K @XHDY@(8989.51)
;** get description **
S XHDDI=0
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<description>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<![CDATA["
F S XHDDI=$O(^XTV(8989.51,XHDDA,20,XHDDI)) Q:+XHDDI'>0 D
. S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)=$G(^XTV(8989.51,XHDDA,20,XHDDI,0))
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="]]>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</description>"
;** get entities **
D GETENTS(XHDY,XHDDA,.XHDI)
;** get keywords **
D KEYWORDS(XHDY,XHDDA,.XHDI)
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</parameterDefinition>"
Q
FLDNAME(XHDFN,FILENUM) ; Resolve field names
Q $$MIXED($P($G(^DD(FILENUM,XHDFN,0)),U))
MIXED(X) ; Return Mixed Case X
N XHDI,WORD,TMP
S TMP="" F XHDI=1:1:$L(X," ") S WORD=$$LOW^XLFSTR($P(X," ",XHDI)),$E(WORD)=$S(XHDI=1:$E(WORD),1:$$UP^XLFSTR($E(WORD))),TMP=$S(TMP="":WORD,1:TMP_WORD)
Q TMP
GETENTS(XHDY,XHDDA,XHDI) ; Get allowable entities
N XHDSDA S XHDSDA=0,FLDS=".01:.02"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<entities>"
F S XHDSDA=$O(^XTV(8989.51,XHDDA,30,XHDSDA)) Q:+XHDSDA'>0 D
. S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<entity>"
. D GETS^DIQ(8989.513,XHDSDA_","_XHDDA_",",FLDS,"E",XHDY)
. F S XHDF=$O(@XHDY@(8989.513,XHDSDA_","_XHDDA_",",XHDF)) Q:XHDF'>0 D
. . N TAG,VAL
. . S TAG=$TR($$FLDNAME(XHDF,8989.513)," /","")
. . S VAL=$G(@XHDY@(8989.513,XHDSDA_","_XHDDA_",",XHDF,"E"))
. . S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<"_TAG_">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">"
. K @XHDY@(8989.513)
. S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</entity>"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</entities>"
Q
KEYWORDS(XHDY,XHDDA,XHDI) ; Get Keywords
N XHDSDA S XHDSDA=0,FLDS=".01"
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<keywords>"
F S XHDSDA=$O(^XTV(8989.51,XHDDA,4,XHDSDA)) Q:+XHDSDA'>0 D
. D GETS^DIQ(8989.514,XHDSDA_","_XHDDA_",",FLDS,"E",XHDY)
. F S XHDF=$O(@XHDY@(8989.514,XHDSDA_","_XHDDA_",",XHDF)) Q:XHDF'>0 D
. . N TAG,VAL
. . S TAG=$TR($$FLDNAME(XHDF,8989.514)," /","")
. . S VAL=$G(@XHDY@(8989.514,XHDSDA_","_XHDDA_",",XHDF,"E"))
. . S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<"_TAG_">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">"
. K @XHDY@(8989.514)
S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="</keywords>"
Q
ONERROR ; Trap errors
N XHDCI S XHDCI=4
; remove remnant of DIQ1 call result
K @XHDCY@(8989.51),@XHDCY@(8989.513)
; remove partial configTree node
F S XHDCI=$O(@XHDCY@("XMLDOC",XHDCI)) Q:+XHDCI'>0 K @XHDCY@("XMLDOC",XHDCI)
; append error node to call result
S XHDCI=4
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<error>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<![CDATA["_$$EC^%ZOSV_"]]>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</error>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
S XHDCY=$NA(^TMP("XHDPTREE",$J,"XMLDOC"))
D ^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXHDPDEF 5686 printed Nov 22, 2024@17:07:28 Page 2
XHDPDEF ; SLC/JER - Parameter Definition Calls ; 25 Jul 2003 9:42 AM
+1 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
LIST(XHDY,FROM,DIR,SIZE) ; Get next SIZE definitions in DIR direction
+1 NEW XHDI,XHDCNT
SET XHDCNT=0
SET SIZE=$GET(SIZE,44)
SET DIR=$GET(DIR,"+1")
+2 ;$S(FROM="":FROM,1:$O(^XTV(8989.51,"B",FROM),-DIR))
SET XHDI=FROM
+3 FOR
SET XHDI=$ORDER(^XTV(8989.51,"B",XHDI),DIR)
if XHDI']""!(XHDCNT'<SIZE)
QUIT
Begin DoDot:1
+4 NEW XHDDA
SET XHDDA=0
+5 FOR
SET XHDDA=$ORDER(^XTV(8989.51,"B",XHDI,XHDDA))
if +XHDDA'>0!(XHDCNT'<SIZE)
QUIT
Begin DoDot:2
+6 SET XHDCNT=XHDCNT+1
SET XHDY(XHDCNT)=XHDDA_U_$PIECE($GET(^XTV(8989.51,+XHDDA,0)),U,1,2)_U_$$ENTSTR(XHDDA)
End DoDot:2
End DoDot:1
+7 QUIT
GETALL(XHDY) ; Gets all parameter definitions in ^TMP("XHDPDEF",$J)
+1 NEW XHDI,XHDCNT
SET XHDI=""
SET XHDCNT=0
SET XHDY=$NAME(^TMP("XHDPDEF",$JOB))
+2 FOR
SET XHDI=$ORDER(^XTV(8989.51,"B",XHDI))
if XHDI']""
QUIT
Begin DoDot:1
+3 NEW XHDDA
SET XHDDA=0
+4 FOR
SET XHDDA=$ORDER(^XTV(8989.51,"B",XHDI,XHDDA))
if +XHDDA'>0
QUIT
Begin DoDot:2
+5 SET XHDCNT=XHDCNT+1
+6 SET @XHDY@(XHDCNT)=XHDDA_U_$PIECE($GET(^XTV(8989.51,XHDDA,0)),U,1,2)_U_$$ENTSTR(XHDDA)
End DoDot:2
End DoDot:1
+7 QUIT
ENTSTR(XHDDA) ; Get applicable entities
+1 NEW XHDI,ENTSTR,ENTCNT
SET ENTSTR=""
SET (ENTCNT,XHDI)=0
+2 FOR
SET XHDI=$ORDER(^XTV(8989.51,XHDDA,30,XHDI))
if XHDI'>0
QUIT
Begin DoDot:1
+3 NEW ENT0
SET ENT0=$GET(^XTV(8989.51,XHDDA,30,XHDI,0))
if +ENT0'>0
QUIT
+4 SET ENTSTR=ENTSTR_$SELECT(ENTCNT=0:"",1:";")_+ENT0_"|"_$$ENTFILE($PIECE(ENT0,U,2))
+5 SET ENTCNT=ENTCNT+1
End DoDot:1
+6 QUIT ENTSTR
ENTFILE(ENTDA) ; Resolve entity name
+1 QUIT $PIECE($GET(^XTV(8989.518,ENTDA,0)),U)
GETXML(XHDY,XHDDA) ; Control Branching
+1 NEW XHDI,XHDJ,X
SET X="ONERROR^XHDPDEF"
SET @^%ZOSF("TRAP")
+2 SET XHDI=0
SET XHDJ=""
+3 SET XHDY=$NAME(^TMP("XHDPDEF",$JOB))
KILL @XHDY
+4 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<?xml version=""1.0"" encoding=""UTF-8""?>"
+5 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<getParameterDefinitionsCallResult>"
+6 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<parameterDefinitionList>"
+7 IF +$GET(XHDDA)
Begin DoDot:1
+8 DO GETDEF(XHDY,XHDDA,.XHDI)
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 FOR
SET XHDJ=$ORDER(^XTV(8989.51,"B",XHDJ))
if XHDJ=""
QUIT
Begin DoDot:2
+11 NEW XHDDA
SET XHDDA=0
+12 FOR
SET XHDDA=$ORDER(^XTV(8989.51,"B",XHDJ,XHDDA))
if +XHDDA'>0
QUIT
Begin DoDot:3
+13 DO GETDEF(XHDY,XHDDA,.XHDI)
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</parameterDefinitionList>"
+15 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</getParameterDefinitionsCallResult>"
+16 SET XHDY=$NAME(^TMP("XHDPDEF",$JOB,"XMLDOC"))
+17 MERGE ^XTMP("XHDPDEF",$JOB,"XMLDOC")=@XHDY
+18 QUIT
FLDS() ; Get field string
+1 QUIT ".01:8"
GETDEF(XHDY,XHDDA,XHDI) ; Loads Top-level Fields
+1 NEW XHDF,XHDDI
SET XHDF=0
+2 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<parameterDefinition>"
+3 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<id>"_XHDDA_"</id>"
+4 DO GETS^DIQ(8989.51,XHDDA_",",$$FLDS,"E",XHDY)
+5 FOR
SET XHDF=$ORDER(@XHDY@(8989.51,XHDDA_",",XHDF))
if XHDF'>0
QUIT
Begin DoDot:1
+6 NEW TAG,VAL
+7 SET TAG=$TRANSLATE($$FLDNAME(XHDF,8989.51)," /","")
+8 SET VAL=$GET(@XHDY@(8989.51,XHDDA_",",XHDF,"E"))
+9 IF $SELECT(XHDF=.03:1,XHDF=.06:1,1:0)
SET VAL=$SELECT(VAL="Yes":"true",1:"false")
+10 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<"_TAG_">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">"
End DoDot:1
+11 KILL @XHDY@(8989.51)
+12 ;** get description **
+13 SET XHDDI=0
+14 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<description>"
+15 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<![CDATA["
+16 FOR
SET XHDDI=$ORDER(^XTV(8989.51,XHDDA,20,XHDDI))
if +XHDDI'>0
QUIT
Begin DoDot:1
+17 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)=$GET(^XTV(8989.51,XHDDA,20,XHDDI,0))
End DoDot:1
+18 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="]]>"
+19 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</description>"
+20 ;** get entities **
+21 DO GETENTS(XHDY,XHDDA,.XHDI)
+22 ;** get keywords **
+23 DO KEYWORDS(XHDY,XHDDA,.XHDI)
+24 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</parameterDefinition>"
+25 QUIT
FLDNAME(XHDFN,FILENUM) ; Resolve field names
+1 QUIT $$MIXED($PIECE($GET(^DD(FILENUM,XHDFN,0)),U))
MIXED(X) ; Return Mixed Case X
+1 NEW XHDI,WORD,TMP
+2 SET TMP=""
FOR XHDI=1:1:$LENGTH(X," ")
SET WORD=$$LOW^XLFSTR($PIECE(X," ",XHDI))
SET $EXTRACT(WORD)=$SELECT(XHDI=1:$EXTRACT(WORD),1:$$UP^XLFSTR($EXTRACT(WORD)))
SET TMP=$SELECT(TMP="":WORD,1:TMP_WORD)
+3 QUIT TMP
GETENTS(XHDY,XHDDA,XHDI) ; Get allowable entities
+1 NEW XHDSDA
SET XHDSDA=0
SET FLDS=".01:.02"
+2 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<entities>"
+3 FOR
SET XHDSDA=$ORDER(^XTV(8989.51,XHDDA,30,XHDSDA))
if +XHDSDA'>0
QUIT
Begin DoDot:1
+4 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<entity>"
+5 DO GETS^DIQ(8989.513,XHDSDA_","_XHDDA_",",FLDS,"E",XHDY)
+6 FOR
SET XHDF=$ORDER(@XHDY@(8989.513,XHDSDA_","_XHDDA_",",XHDF))
if XHDF'>0
QUIT
Begin DoDot:2
+7 NEW TAG,VAL
+8 SET TAG=$TRANSLATE($$FLDNAME(XHDF,8989.513)," /","")
+9 SET VAL=$GET(@XHDY@(8989.513,XHDSDA_","_XHDDA_",",XHDF,"E"))
+10 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<"_TAG_">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">"
End DoDot:2
+11 KILL @XHDY@(8989.513)
+12 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</entity>"
End DoDot:1
+13 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</entities>"
+14 QUIT
KEYWORDS(XHDY,XHDDA,XHDI) ; Get Keywords
+1 NEW XHDSDA
SET XHDSDA=0
SET FLDS=".01"
+2 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<keywords>"
+3 FOR
SET XHDSDA=$ORDER(^XTV(8989.51,XHDDA,4,XHDSDA))
if +XHDSDA'>0
QUIT
Begin DoDot:1
+4 DO GETS^DIQ(8989.514,XHDSDA_","_XHDDA_",",FLDS,"E",XHDY)
+5 FOR
SET XHDF=$ORDER(@XHDY@(8989.514,XHDSDA_","_XHDDA_",",XHDF))
if XHDF'>0
QUIT
Begin DoDot:2
+6 NEW TAG,VAL
+7 SET TAG=$TRANSLATE($$FLDNAME(XHDF,8989.514)," /","")
+8 SET VAL=$GET(@XHDY@(8989.514,XHDSDA_","_XHDDA_",",XHDF,"E"))
+9 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<"_TAG_">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">"
End DoDot:2
+10 KILL @XHDY@(8989.514)
End DoDot:1
+11 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="</keywords>"
+12 QUIT
ONERROR ; Trap errors
+1 NEW XHDCI
SET XHDCI=4
+2 ; remove remnant of DIQ1 call result
+3 KILL @XHDCY@(8989.51),@XHDCY@(8989.513)
+4 ; remove partial configTree node
+5 FOR
SET XHDCI=$ORDER(@XHDCY@("XMLDOC",XHDCI))
if +XHDCI'>0
QUIT
KILL @XHDCY@("XMLDOC",XHDCI)
+6 ; append error node to call result
+7 SET XHDCI=4
+8 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<error>"
+9 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<![CDATA["_$$EC^%ZOSV_"]]>"
+10 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</error>"
+11 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
+12 SET XHDCY=$NAME(^TMP("XHDPTREE",$JOB,"XMLDOC"))
+13 DO ^%ZTER
+14 QUIT
