DD ;Data dictionary [ 10/29/2001  11:24 AM ]
FR(sRec) New sR 
 Set sR=$G(^DD("R",sRec))
 Goto:sR="" EXISTR
 Set $ZT="TRAPR"
 Quit @sR
 ;Get record
GR(sRec) New sR 
 Set sR=$G(^DD("R",sRec))
 Goto:sR="" EXISTR
 Set $ZT="TRAPR"
 Quit $G(@sR)
 ;Save record
CR(sRec1,sRec2) 
 Do SR^DD(sRec1,$$GR^DD(sRec2))
 Quit
SR(sRec,sVal) New sR
 Set sR=$G(^DD("R",sRec))
 Goto:sR="" EXISTR
 Goto:'$D(sVal) SR2 
 Set $ZT="TRAPR" 
 Set @sR=sVal
 Quit
SR2 W !!,"SetsRecord "_sRec_" : Geen value ingevuld",!! Hang 2 ZTrap
 ; Kill record
KR(sRec,sParams) New sR
 Kill @$$GRN(sRec,$G(sParams))
 Quit
 ; $DATA record
DRN(sRec,sParams) 
 Quit $D(@$$GRN^DD(sRec,$G(sParams)))
 ; Lock Record
LRN(sRec,sParams,UL) 
 If $G(UL)="-" X "Lock -"_$$GRN^DD(sRec,$G(sParams)) Q
 Do ADD^vhLock($$GRN^DD(sRec,$G(sParams)))
 Quit
 ; $ORDER record
ORN(sRec,sParams,Next) 
 Quit:'$D(Next) $O(@$$GRN(sRec,$G(sParams)))
 Quit $O(@$$GRN(sRec,$G(sParams)),Next)
 ;Get record node
GRN(sRec,sParams) New sR
 Set sR=$G(^DD("R",sRec))
 Goto:sR="" EXISTR
 Set $ZT="TRAPR"
 Quit:$G(sParams)="" sR
 Quit:sParams=0 $P(sR,"(")
 Quit:sParams>0 $P(sR,",",1,sParams)_")"
 Quit:sParams<0 $P(sR,",",1,$L(sR,",")+sParams)_")"
 ; *** Count ***
 ;Fetch count
FC(sRec) New sR
 Set sR=$G(^DD("C",sRec))
 Goto:sR="" EXISTC
 Set $ZT="TRAPR"
 X "Set sR=$P("_$P(sR,"`",1)_","_$P(sR,"`",2)_","_$P(sR,"`",3)_")"
 Quit sR
 ;Save count
SC(sRec,sVal)  New sR
 Set sR=$G(^DD("C",sRec))
 Goto:sR="" EXISTC
 Goto:'$D(sVal) SC2
 If '$D(sVal) W !!,"SetCount "_sRec_" : Geen value ingevuld",!! Hang 2 ZTrap
 Set $ZT="TRAPR"
 X "Set $P("_$P(sR,"`",1)_","_$P(sR,"`",2)_","_$P(sR,"`",3)_")=sVal"
 Quit
SC2 W !!,"SetCount "_sRec_" : Geen value ingevuld",!! Hang 2 ZTrap
 ;Get count node
GCN(sRec,sParams) New sR
 Set sR=$P($G(^DD("C",sRec)),"`",1)
 Goto:sR="" EXISTC
 Set $ZT="TRAPR"
 Quit:'$D(sParams) sR
 Quit:sParams=0 $P(sR,"(")
 Quit:sParams>0 $P(sR,",",1,sParams)_")"
 Quit:sParams<0 $P(sR,",",1,$L(sR,",")+sParams)_")"
 ;Get count piece number
GCP(sRec) New sR
 Set sR=$G(^DD("C",sRec))
 Goto:sR="" EXISTC
 Set $ZT="TRAPR"
 Quit $P(sR,"`",3)
 ; *** Field ***
 ;Exist field in datadictionary
EF(sFld) Quit $D(^DD("F",sFld))
 ;Fetch field value
FF(sFld) New sR
 Set sR=$G(^DD("F",sFld))
 Goto:sR="" EXISTF
 Set $ZT="TRAPF"
 X "Set sR=$P("_$P(sR,"`",1)_","_$P(sR,"`",2)_","_$P(sR,"`",3)_")"
 Quit sR
 
 ;Get field value
GF(sFld) New sR
 Set sR=$G(^DD("F",sFld))
 Goto:sR="" EXISTF
 Set $ZT="TRAPF"
 X "Set sR=$P($G("_$P(sR,"`",1)_"),"_$P(sR,"`",2)_","_$P(sR,"`",3)_")"
 Quit sR
 ;Save field
SF(sFld,sVal) New sR
 Set sR=$G(^DD("F",sFld))
 Goto:sR="" EXISTF
 Goto:'$D(sVal) SF2
 Set $ZT="TRAPF"
 X "Set $P("_$P(sR,"`",1)_","_$P(sR,"`",2)_","_$P(sR,"`",3)_")=sVal"
 Quit
SF2 W !!,"SetField "_sFld_" : Geen value ingevuld",!! Hang 2 ZTrap
 ; Copy field
CF(sFld1,sFld2) 
 Do SF^DD(sFld1,$$FF^DD(sFld2))
 Quit
 ;Get field node
GFN(sFld,sParams) New sR
 Set sR=$P($G(^DD("F",sFld)),"`",1)
 Goto:sR="" EXISTF
 Set $ZT="TRAPF"
 Quit:'$D(sParams) sR
 Quit:sParams=0 $P(sR,"(")
 Quit:sParams>0 $P(sR,",",1,sParams)_")"
 Quit:sParams<0 $P(sR,",",1,$L(sR,",")+sParams)_")"
 ;Get field piece
GFP(sFld) New sR
 Set sR=$G(^DD("F",sFld))
 Goto:sR="" EXISTF
 Set $ZT="TRAPF"
 Quit $P(sR,"`",3)
 ; Get field values and assign it to their proper DD-names
FFs(sFlds) 
 New sFld,J,R
 For J=1:1:$L(sFlds,";") Do
 .Set sFld=$P(sFlds,";",J)
 .Set sR=$G(^DD("F",sFld))
 .Goto:sR="" EXISTF
 .Set $ZT="TRAPF"
 .X "Set "_sFld_"=$P("_$P(sR,"`",1)_","_$P(sR,"`",2)_","_$P(sR,"`",3)_")"
 Quit
SFs(sFlds)  New sFld,J,R
 For J=1:1:$L(sFlds,";") Do
 .Set sFld=$P(sFlds,";",J)
 .Set sR=$G(^DD("F",sFld))
 .Goto:sR="" EXISTF
 .Goto:'$D(sFld) SF2
 .Set $ZT="TRAPF"
 .X "Set $P("_$P(sR,"`",1)_","_$P(sR,"`",2)_","_$P(sR,"`",3)_")="_sFld
 Quit
 ;--------
TRAPF w !,!,"**** Voor field ",sFld," node niet gedefinieerd ****",!,!
 Hang 2 ZQuit
TRAPR w !,!,"**** Voor record ",sRec," node niet gedefinieerd ****",!,!
 Hang 2 ZQuit
 ; *** sRecord ***
 ;Fetch record
EXISTR w !,!,"**** sRecord ",sRec," bestaat niet ****",!,!
 Hang 2
 ZTrap
EXISTC w !,!,"**** Count van sRecord ",sRec," bestaat niet ****",!,!
 Hang 2
 ZTrap
EXISTF w !,!,"**** Field ",sFld," bestaat niet ****",!,!
 Hang 2
 ZTrap
 ;--------
UF(F) N sFld  
 Set sFld=$P(^cyd(F,0),"^",1)
 Quit:$G(^cyd(F,"d"))="" 
 Quit:$G(^cyd(F,"g"))="" 
 Quit:'$P($G(^cyd(F,0)),"^",6)
 Set Delim=^cyd(F,"d")
 Set:$L(Delim)=0 Delim="\"
 Set:$L(Delim)=1 Delim=""""_Delim_""""
 Set ^DD("F",sFld)=^cyd(F,"g")_"`"_Delim_"`"_$P(^cyd(F,0),"^",6)
 Set ^["ADMIN1"]DD("C",sFld)=^DD("F",sFld)
 Quit
UR(R)   
 N sRec
 Set sRec=$P(^cydf(R,0),"^",1)
 Quit:$G(^cydf(R,"g"))=""
 Set ^DD("R",sRec)=^cydf(R,"g")
 Set ^["ADMIN1"]DD("R",sRec)=^DD("R",sRec)
 Quit:$G(^cydf(R,"cr"))=""
 Quit:'$D(^cydf(R,"cp"))
 Set Delim=$P(^cydf(R,"cp"),",",2)
 Set:'$L(Delim) Delim="""\"""
 Set ^DD("C",sRec)=^cydf(R,"cr")_"`"_Delim_"`"_+$P(^cydf(R,"cp"),",",3)
 Set ^["ADMIN1"]DD("C",sRec)=^DD("C",sRec)
 Quit
GETKEY(Fld,Incr) 
 New sKey
 Set:$G(Incr)="" Incr=+1
 Lock +(@$$GFN^DD(Fld))
 Set sKey=$$GF^DD(Fld)+Incr
 Do SF^DD(Fld,sKey)
 Lock -(@$$GFN^DD(Fld))
 Quit sKey
KTRANS j KTRANS^DD["NEW,NEW"] Quit
 Kill ^DD
 Kill ^["ADMIN1"]DD("C")
 Kill ^["ADMIN1"]DD("F")
 Kill ^["ADMIN1"]DD("R")
TRANS j TRANS^DD["NEW,NEW"] Quit
 S sR=1 For  Set sR=$O(^cyd(sR)) Q:sR'?1.N  Do UF(sR)
 S sR=1 For  Set sR=$O(^cydf(sR)) Q:sR'?1.N  Do UR(sR)
 Quit