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

DIKC2.m

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