199 lines
6.6 KiB
Mathematica
199 lines
6.6 KiB
Mathematica
DIKC2 ;SFISC/MKO-CHECK INPUT PARAMETERS TO INDEX^DIKC ;8:25 AM 30 Jul 1999
|
|
;;22.0;VA FileMan;**11**;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;CHK: Check input parameters to INDEX^DIKC
|
|
;Also set:
|
|
; DA = DA array
|
|
; DIROOT = Closed root of file
|
|
; DIFILE = File #
|
|
; DIKERR = "X" : if there's a problem
|
|
;
|
|
CHK ;File is a required input param
|
|
I $G(DIFILE)="" D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D ERR Q
|
|
;
|
|
;Check DIREC and set DA array
|
|
I $G(DIREC)'["," M DA=DIREC
|
|
E S:DIREC'?.E1"," DIREC=DIREC_"," D DA^DILF(DIREC,.DA)
|
|
S:'$G(DA) DA=""
|
|
I '$$VDA^DIKCU1(.DA,DIF) D ERR Q
|
|
;
|
|
;Check DICTRL parameter
|
|
I $G(DICTRL)]"",'$$VFLAG^DIKCU1(DICTRL,"KSsDWiRIkCTrf",DIF) D ERR
|
|
I $G(DICTRL)["W",'$$VFNUM^DIKCU1(+$P(DICTRL,"W",2),DIF) D ERR
|
|
I $G(DICTRL)["C",$G(DICTRL)["T" D
|
|
. D:DIF["D" ERR^DIKCU2(301,"","","","C and T")
|
|
. D ERR
|
|
E I $G(DICTRL)["C",$G(DICTRL)["K" D
|
|
. D:DIF["D" ERR^DIKCU2(301,"","","","C and K")
|
|
. D ERR
|
|
E I $G(DICTRL)["T",$G(DICTRL)["S" D
|
|
. D:DIF["D" ERR^DIKCU2(301,"","","","T and S")
|
|
. D ERR
|
|
Q:$G(DIKERR)="X"
|
|
;
|
|
;Set DIFILE and DIROOT
|
|
N DILEV
|
|
I DIFILE=+$P(DIFILE,"E") D
|
|
. S DIROOT=$$FROOTDA^DIKCU(DIFILE,DIF,.DILEV) I DIROOT="" D ERR Q
|
|
. I DILEV,$D(DA(DILEV))[0 D Q
|
|
.. D:DIF["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
|
|
. S:DILEV DIROOT=$NA(@DIROOT)
|
|
. S DIFILE=$$FNUM^DIKCU(DIROOT,DIF) I DIFILE="" D ERR
|
|
E D
|
|
. S DIROOT=DIFILE
|
|
. S:"(,"[$E(DIROOT,$L(DIROOT)) DIROOT=$$CREF^DILF(DIFILE)
|
|
. S DIFILE=$$FNUM^DIKCU(DIROOT,DIF) I DIFILE="" D ERR Q
|
|
. S DILEV=$$FLEV^DIKCU(DIFILE,DIF) I DILEV="" D ERR Q
|
|
. I DILEV,$D(DA(DILEV))[0 D Q
|
|
.. D:DIF["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
|
|
;
|
|
;Set DIKVAL,DIKON
|
|
S DIKVAL=$G(DICTRL("VAL"))
|
|
I DIKVAL]"" D
|
|
. S:"(,_"'[$E(DIKVAL,$L(DIKVAL)) DIKVAL=$$OREF^DILF(DIKVAL)
|
|
. S DIKON="O^N"
|
|
E S DIKON=""
|
|
Q
|
|
;
|
|
ERR ;Set error flag
|
|
S DIKERR="X"
|
|
Q
|
|
;
|
|
;==========================
|
|
; CRV(Index,ValueRoot,TMP)
|
|
;==========================
|
|
;Load values from Cross Reference Values multiple into @TMP
|
|
;In:
|
|
; XR = Index #
|
|
; VALRT = Array Ref where old/new values are located
|
|
; TMP = Root of array to store data
|
|
;Returns:
|
|
; @TMP@(RootFile,Index#) = Name^File^RootType^Type
|
|
; Index#,Order#) = Code that sets X to the data
|
|
; Order#,"SS") = Subscript^MaxLength
|
|
; "T") = Transform (for 'Field'-type)
|
|
; "F") = file^field^levdiff(file,rFile)
|
|
CRV(XR,VALRT,TMP) ;
|
|
Q:'$G(XR)!($G(TMP)="")
|
|
N CRV,CRV0,DEC,FIL,FLD,MAXL,ND,ORD,OROOT,RFIL,SBSC,TYPE
|
|
;
|
|
S RFIL=$P($G(^DD("IX",XR,0)),U,9) Q:RFIL="" Q:$D(@TMP@(RFIL,XR))
|
|
S @TMP@(RFIL,XR)=$P(^DD("IX",XR,0),U,2)_U_$P(^(0),U)_U_$P(^(0),U,8)_U_$P(^(0),U,4)
|
|
S OROOT=$$FROOTDA^DIKCU(RFIL,"O")_"DA," Q:OROOT="DA,"
|
|
;
|
|
S CRV=0 F S CRV=$O(^DD("IX",XR,11.1,CRV)) Q:'CRV D
|
|
. S CRV0=$G(^DD("IX",XR,11.1,CRV,0))
|
|
. S ORD=$P(CRV0,U),TYPE=$P(CRV0,U,2),MAXL=$P(CRV0,U,5),SBSC=$P(CRV0,U,6)
|
|
. Q:ORD=""!(TYPE="")
|
|
. ;
|
|
. I TYPE="F" D
|
|
.. S FIL=$P(CRV0,U,3),FLD=$P(CRV0,U,4) Q:(FIL="")!'FLD
|
|
.. I FIL'=RFIL N OROOT,LDIF D Q:$G(OROOT)=""
|
|
... S LDIF=$$FLEVDIFF^DIKCU(FIL,RFIL) Q:'LDIF
|
|
... S OROOT=$$FROOTDA^DIKCU(FIL,LDIF_"O") Q:OROOT=""
|
|
... S OROOT=OROOT_"DA("_LDIF_"),"
|
|
.. S DEC=$$DEC(FIL,FLD,$G(VALRT),OROOT) Q:DEC=""
|
|
.. S @TMP@(RFIL,XR,ORD)=DEC
|
|
.. S @TMP@(RFIL,XR,ORD,"F")=FIL_U_FLD_$S($G(LDIF):U_LDIF,1:"")
|
|
.. S:$G(^DD("IX",XR,11.1,CRV,2))'?."^" @TMP@(RFIL,XR,ORD,"T")=^(2)
|
|
. ;
|
|
. E I TYPE="C" S @TMP@(RFIL,XR,ORD)=$G(^DD("IX",XR,11.1,CRV,1.5))
|
|
. ;
|
|
. S:SBSC @TMP@(RFIL,XR,ORD,"SS")=SBSC_$S(MAXL:U_MAXL,1:"")
|
|
Q
|
|
;
|
|
;======================================
|
|
; $$DEC(File,Field,ValueRoot,OpenRoot)
|
|
;======================================
|
|
;Return Data Extraction Code -- M code that sets X equal to the data.
|
|
;In:
|
|
; FIL = File #
|
|
; FLD = Field #
|
|
; VALRT = Array Ref where old/new values are located
|
|
; if ends in "_", FILE subscript is concatenated to the last
|
|
; subscript (used by DDS02)
|
|
; OROOT = Open root of record w/ DA subscripts
|
|
;Returns: M code
|
|
; For example:
|
|
; S X=$P(^DIZ(1000,DA(1),100,0),U,2) or
|
|
; S X=$E(^DIZ(1000,DA(1),100,1),1,245) or
|
|
; S X=$G(array(file,DIIENS,field,DION),$P(^root(DA,nd),U,pc))
|
|
;
|
|
DEC(FIL,FLD,VALRT,OROOT) ;
|
|
Q:$P($G(^DD(FIL,FLD,0)),U)="" ""
|
|
;
|
|
N ND,PC,DEC
|
|
S PC=$P($G(^DD(FIL,FLD,0)),U,4)
|
|
S ND=$P(PC,";"),PC=$P(PC,";",2) Q:ND?." "!("0 "[PC) ""
|
|
S:ND'=+$P(ND,"E") ND=""""_ND_""""
|
|
;
|
|
I $G(OROOT)="" S OROOT=$$FROOTDA^DIKCU(FIL,"O")_"DA," Q:OROOT="DA," ""
|
|
I PC S DEC="$P($G("_OROOT_ND_")),U,"_PC_")"
|
|
E S DEC="$E($G("_OROOT_ND_")),"_+$E(PC,2,999)_","_$P(PC,",",2)_")"
|
|
;
|
|
I $G(VALRT)]"" D
|
|
. I $E(VALRT,$L(VALRT))="_" D Q
|
|
.. S VALRT=$E(VALRT,1,$L(VALRT)-3)
|
|
.. S DEC="$G("_VALRT_FIL_""",DIIENS,"_FLD_",DION),"_DEC_")"
|
|
. S:"(,"'[$E(VALRT,$L(VALRT)) VALRT=$$OREF^DILF(VALRT)
|
|
. S DEC="$G("_VALRT_FIL_",DIIENS,"_FLD_",DION),"_DEC_")"
|
|
S DEC="S X="_DEC
|
|
Q DEC
|
|
;
|
|
;======================
|
|
; LOG(Index,Logic,TMP)
|
|
;======================
|
|
;Load Set and/or Kill logic into into @TMP
|
|
;In:
|
|
; XR = Index #
|
|
; LOG [ K : load kill logic
|
|
; [ S : load set logic
|
|
; TMP = Root of array to store data
|
|
;Returns:
|
|
; @TMP@(RootFile,Index#,"S") = Set logic
|
|
; "SC") = Set condition
|
|
; "K") = Kill logic
|
|
; "KC") = Kill condtion
|
|
LOG(XR,LOG,TMP) ;
|
|
Q:'$G(XR) Q:$G(LOG)="" Q:$G(TMP)=""
|
|
N SL,KL,SC,KC,RFIL
|
|
;
|
|
S RFIL=$P(^DD("IX",XR,0),U,9) Q:RFIL=""
|
|
I LOG["S" D
|
|
. S SL=$G(^DD("IX",XR,1)),SC=$G(^(1.4))
|
|
. I "Q"'[SL,SL'?."^" S @TMP@(RFIL,XR,"S")=SL
|
|
. I "Q"'[SC,SC'?."^" S @TMP@(RFIL,XR,"SC")=SC
|
|
I LOG["K" D
|
|
. S KL=$G(^DD("IX",XR,2)),KC=$G(^(2.4))
|
|
. I "Q"'[KL,KL'?."^" S @TMP@(RFIL,XR,"K")=KL
|
|
. I "Q"'[KC,KC'?."^" S @TMP@(RFIL,XR,"KC")=KC
|
|
Q
|
|
;
|
|
;===============
|
|
; KW(Index,TMP)
|
|
;===============
|
|
;Load Kill Entire Index logic into @TMP
|
|
;In:
|
|
; XR = Index #
|
|
; TMP = Root of array to store data
|
|
;Returns:
|
|
; @TMP@("KW",File#[.01],Index#) = Kill Entire Index logic
|
|
; Index#,0) = Type ("W" for whole-file index)
|
|
; ^RootFile
|
|
; ^Level difference between top file
|
|
; and root file
|
|
KW(XR,TMP) ;Get Kill Entire Index logic
|
|
Q:'$G(XR)!($G(TMP)="")
|
|
N FILE,KW,RFIL,TYPE
|
|
S KW=$G(^DD("IX",XR,2.5)) Q:KW="Q"!(KW?."^")
|
|
S FILE=$P($G(^DD("IX",XR,0)),U),TYPE=$P(^(0),U,8),RFIL=$P(^(0),U,9)
|
|
Q:FILE=""!(RFIL="")
|
|
;
|
|
S @TMP@("KW",FILE,XR)=KW
|
|
S:RFIL'=FILE @TMP@("KW",FILE,XR,0)=TYPE_U_RFIL_U_$$FLEVDIFF^DIKCU(FILE,RFIL)
|
|
Q
|
|
;
|
|
;#202 The input parameter that identifies the |1| is missing or invalid.
|
|
;#205 File# |1| and IEN string |IENS| represent different subfile levels.
|
|
;
|