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