Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: CIAVMCFG

CIAVMCFG.m

Go to the documentation of this file.
  1. CIAVMCFG ;MSC/IND/DKM - VueCentric Configuration RPC's ;03-Oct-2007 12:47;DKM
  1. ;;1.1V2;VUECENTRIC FRAMEWORK;;Mar 20, 2007
  1. ;;Copyright 2000-2006, Medsphere Systems Corporation
  1. ;=================================================================
  1. ; Fetch object registry info
  1. GETREG(DATA) ;
  1. N X,Z,CT,FL,ML,ND,PC,KC,HK,PM,AK,ID,DS,SP,SC,DF
  1. S SC=";"
  1. F X=0:1 S Z=$P($T(CTL+X),SC,3,99) Q:'$L(Z) D
  1. .S FL($P(Z,SC,2),$P(Z,SC,3))=+Z_SC_$P(Z,SC,4,5)
  1. S DATA=$$TMPGBL,X=0,CT=0,PM=$$KCHK^XUSRB("XUPROGMODE")
  1. F S X=$O(^CIAVOBJ(19930.2,X)),ND="",(KC,HK,AK,DS)=0 Q:'X D
  1. .F S ND=$O(^CIAVOBJ(19930.2,X,ND)),PC="" D Q:ND=-1
  1. ..I ND="" S Z="",ND=-1
  1. ..E S Z=$G(^CIAVOBJ(19930.2,X,ND))
  1. ..F S PC=$O(FL(ND,PC)) Q:PC="" D
  1. ...S ID=FL(ND,PC),DF=$P(ID,SC,2),SP=$P(ID,SC,3),ID=+ID,ML=0
  1. ...I PC D ADDIT(ID,$P(Z,U,PC),SP) Q
  1. ...F S ML=$O(^CIAVOBJ(19930.2,X,ND,ML)) Q:'ML D ADDIT(ID,$G(^(ML,0)),SP)
  1. Q
  1. ; Process field value where
  1. ; ID = unique id
  1. ; VAL = field value
  1. ; SP = optional special processing entry point
  1. ADDIT(ID,VAL,SP) ;
  1. I $G(SP)="" S:$L(VAL)&(VAL'=DF) CT=CT+1,@DATA@(CT)=ID_"="_VAL
  1. E D @SP
  1. Q
  1. ; CATEGORY multiple
  1. SPCAT D ADDIT(ID,$$GETNAM(19930.21,+VAL))
  1. Q
  1. ; USES multiple
  1. SPUSES D ADDIT(ID,$P($G(^CIAVOBJ(19930.2,+VAL,0)),U))
  1. Q
  1. ; INITIALIZATION multiple
  1. SPINIT S VAL=$$TRIM^CIAU(VAL)
  1. S:VAL["=@" VAL=$P(VAL,"=@")_"="_$$GET^XPAR("ALL",$P(VAL,"=@",2,99))
  1. D ADDIT(ID,VAL)
  1. Q
  1. ; Disabled flag
  1. SPDIS S DS=+VAL
  1. Q
  1. ; Process ALLKEYS field
  1. SPALL S AK=+VAL
  1. Q
  1. ; Check security keys
  1. SPKEY S KC=KC+1,HK=HK+$$HASKEY(VAL)
  1. Q
  1. ; Compute accessibility of object
  1. ; 0 = object enabled
  1. ; 1 = object disabled
  1. ; 2 = object access denied
  1. SPACC D ADDIT(ID,$S(DS:1,PM:0,'KC:0,AK:HK<KC*2,1:'HK*2))
  1. Q
  1. ; Return true if user has key
  1. HASKEY(KEY) ;
  1. S:KEY=+KEY KEY=$$LKUP^XPDKEY(KEY)
  1. Q $S($L(KEY):''$$KCHK^XUSRB(KEY),1:0)
  1. ; Set security keys for entry in object registry
  1. SETKEYS(DATA,IEN,VALS,BRD) ;
  1. D SETMULT(3,19930.204)
  1. Q
  1. ; Set uses multiple for entry in object registry
  1. SETUSES(DATA,IEN,VALS,BRD) ;
  1. D SETMULT(9,19930.221)
  1. Q
  1. ; Set category multiple for entry in object registry
  1. SETCAT(DATA,IEN,VALS,BRD) ;
  1. D SETMULT(2,19930.206)
  1. Q
  1. ; Set specified multiple field
  1. SETMULT(NODE,SUB) ;
  1. N VAL,CNT
  1. S IEN=+IEN,DATA=$D(^CIAVOBJ(19930.2,IEN,0)),VALS="",CNT=0
  1. Q:'DATA
  1. L +^CIAVOBJ(19930.2,IEN):5
  1. E S DATA=0 Q
  1. K ^CIAVOBJ(19930.2,IEN,NODE)
  1. F S VALS=$O(VALS(VALS)) Q:VALS="" D
  1. .S VAL=$G(VALS(VALS),$G(VALS(VALS,0)))
  1. .S:$L(VAL) VAL=+$S(NODE=3:$$LKUP^XPDKEY(VAL),NODE=9:$$GETIEN(19930.2,VAL),NODE=2:$$GETIEN(19930.21,VAL),1:0)
  1. .S:VAL>0 CNT=CNT+1,^CIAVOBJ(19930.2,IEN,NODE,CNT,0)=VAL,^CIAVOBJ(19930.2,IEN,NODE,"B",VAL,CNT)=""
  1. S:CNT ^CIAVOBJ(19930.2,IEN,NODE,0)=U_SUB_"P^"_CNT_U_CNT
  1. L -^CIAVOBJ(19930.2,IEN)
  1. D:$G(BRD) BRDCAST^CIANBEVT("REGISTRY.OBJECT","")
  1. Q
  1. ; Return template data
  1. GETTEMPL(DATA,TMPL) ;
  1. S DATA=$$TMPGBL,TMPL=$$TMPL(TMPL)
  1. M:TMPL @DATA=^CIAVTPL(TMPL,1)
  1. K @DATA@(0)
  1. Q
  1. ; Set template data
  1. SETTEMPL(DATA,TMPL,CNT,VAL) ;
  1. N X,Y,Z
  1. S DATA=$$TMPL(.TMPL,.Z)
  1. I 'DATA,CNT D
  1. .L +^CIAVTPL(0):5
  1. .E Q
  1. .S DATA=$O(^CIAVTPL($C(1)),-1)+1,$P(^(0),U,3,4)=DATA_U_($P(^(0),U,4)+1),^(DATA,0)=TMPL,^CIAVTPL("B",Z,DATA)=""
  1. .L -^CIAVTPL(0)
  1. Q:'DATA
  1. L +^CIAVTPL(DATA):5
  1. E S DATA=0 Q
  1. I 'CNT D
  1. .D TMPLDEL(TMPL)
  1. E D WP^DIE(19930.3,DATA_",",1,,"VAL"),RENTPL^CIAVINIT(DATA)
  1. L -^CIAVTPL(DATA)
  1. D BRDCAST^CIANBEVT("REGISTRY.TEMPLATE","")
  1. Q
  1. ; Delete a template and all its associations
  1. TMPLDEL(TMPL) ;
  1. N DIK,DA,ENT
  1. D TMPLPAR(.ENT,.TMPL)
  1. S ENT=""
  1. F S ENT=$O(ENT(ENT)) Q:'$L(ENT) D
  1. .D DEL^XPAR(ENT,"CIAVM DEFAULT TEMPLATE")
  1. S DIK="^CIAVTPL(",DA=TMPL
  1. D ^DIK
  1. Q
  1. ; Get parameters associated with a template
  1. ; Return format is DATA(<entity>,1)=<template IEN>
  1. TMPLPAR(DATA,TMPL) ;
  1. N X
  1. K DATA
  1. S:TMPL'=+TMPL TMPL=$$TMPL(TMPL)
  1. Q:'TMPL
  1. D ENVAL^XPAR(.DATA,"CIAVM DEFAULT TEMPLATE")
  1. S X=""
  1. F S X=$O(DATA(X)) Q:'$L(X) D:$G(DATA(X,1))'=TMPL
  1. .K DATA(X)
  1. .S DATA=DATA-1
  1. Q
  1. ; Return all template default associations
  1. ; Return format is DATA(n)=<template name>^<entity type>^<entity external value>^<entity internal value>
  1. TMPLPARX(DATA) ;
  1. N X,TMP,TMPL,IEN,ENT,TYP,XRF,CNT
  1. S DATA=$$TMPGBL^CIAVMRPC,TMP="",CNT=0
  1. F S TMP=$O(^XTV(8989.518,"C",TMP)) Q:'$L(TMP) S XRF=$O(^(TMP,0)) D
  1. .S XRF=$$ROOT^DILFD(XRF)
  1. .S:$L(XRF) XRF(XRF)=TMP
  1. D ENVAL^XPAR(.TMP,"CIAVM DEFAULT TEMPLATE")
  1. S X="",TMP=0
  1. F S X=$O(TMP(X)) Q:'$L(X) D
  1. .S TMPL=$P($G(^CIAVTPL(+$G(TMP(X,1)),0)),U)
  1. .S:'$L(TMPL) TMPL="<Deleted Template #"_+$G(TMP(X,1))_">"
  1. .S IEN=+X,TYP=U_$P(X,";",2),ENT=$P($G(@(TYP_IEN_",0)")),U),TYP=$G(XRF(TYP))
  1. .S CNT=CNT+1,@DATA@(CNT)=TMPL_U_TYP_U_ENT_U_IEN
  1. Q
  1. ; Convert template name to IEN
  1. TMPL(X,Y) ;
  1. Q $$GETIEN(19930.3,.X,.Y)
  1. ; Convert object name to IEN
  1. PRGID(X,Y) ;
  1. Q $$GETIEN(19930.2,.X,.Y)
  1. ; Convert IEN to .01 value
  1. GETNAM(FNUM,IEN) ;
  1. Q $P($G(@$$ROOT^DILFD(FNUM,,1)@(IEN,0)),U)
  1. ; Convert .01 value to IEN
  1. GETIEN(FNUM,VAL,TRC) ;
  1. N RTN,GBL,PASS
  1. S GBL=$$ROOT^DILFD(FNUM,,1),RTN=0
  1. I $L(GBL),$L(VAL),VAL'=+VAL D
  1. .F PASS=0,1 D Q:RTN
  1. ..S:PASS VAL=$$UP^XLFSTR(VAL)
  1. ..S TRC=$E(VAL,1,30)
  1. ..F S RTN=+$O(@GBL@("B",TRC,RTN)) Q:'RTN Q:$P($G(@GBL@(RTN,0)),U)=VAL
  1. Q RTN
  1. ; Return temp global reference
  1. TMPGBL() N GBL
  1. S GBL=$NA(^TMP("CIAVMCFG",$J))
  1. K @GBL
  1. Q GBL
  1. ; Input transform for CLSID
  1. XFCLSID(X) ;
  1. S X=$$UP^XLFSTR($TR(X,"{}- "))
  1. I $L(X)>32 K X Q
  1. I $L($TR(X,"0123456789ABCDEF")) K X Q
  1. S X=$$RJ^XLFSTR(X,32,0),X="{"_$E(X,1,8)_"-"_$E(X,9,12)_"-"_$E(X,13,16)_"-"_$E(X,17,20)_"-"_$E(X,21,32)_"}"
  1. Q
  1. ; Control info for object registry output
  1. ; Format is: id;node;piece;dflt;spec
  1. ; id = unique id for data element
  1. ; node = global node for data element
  1. ; if -1, processed at end of each record
  1. ; piece = piece # within node
  1. ; if 0, indicates WP or multiple field
  1. ; dflt = default value
  1. ; spec = entry point for special processing
  1. CTL ;;0;0;1
  1. ;;1;0;2
  1. ;;2;0;3
  1. ;;3;0;4;0
  1. ;;4;0;5;0
  1. ;;5;1;1
  1. ;;6;2;0;;SPCAT
  1. ;;7;7;9;0
  1. ;;8;7;1;0
  1. ;;9;7;2;0
  1. ;;10;-1;1;0;SPACC
  1. ;;11;4;0
  1. ;;12;5;0;;SPINIT
  1. ;;13;6;0
  1. ;;14;7;5;0
  1. ;;15;9;0;;SPUSES
  1. ;;16;7;6;0
  1. ;;17;7;7;0
  1. ;;18;7;8;0
  1. ;;19;.5;1
  1. ;;20;7;10;0
  1. ;;21;0;6
  1. ;;97;7;3;;SPDIS
  1. ;;98;7;4;;SPALL
  1. ;;99;3;0;;SPKEY
  1. ;;