- 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 Feb 18, 2025@23:23:41 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