| 1 | DIKCU ;SFISC/MKO-LIBRARY OF GENERIC MODULES ;9:29 AM 22 Oct 1998
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;===============
|
|---|
| 5 | ; PUSHDA(.DA,N)
|
|---|
| 6 | ;===============
|
|---|
| 7 | ;Push down the DA array, N times
|
|---|
| 8 | ;
|
|---|
| 9 | PUSHDA(DA,N) ;
|
|---|
| 10 | N I
|
|---|
| 11 | S:'$G(N) N=1
|
|---|
| 12 | F I=+$O(DA(""),-1):-1:1 S DA(I+N)=$G(DA(I))
|
|---|
| 13 | S DA(N)=$G(DA)
|
|---|
| 14 | S DA=0 F I=N-1:-1:1 S DA(I)=0
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;==============
|
|---|
| 18 | ; POPDA(.DA,N)
|
|---|
| 19 | ;==============
|
|---|
| 20 | ;Pop the DA array
|
|---|
| 21 | ;
|
|---|
| 22 | POPDA(DA,N) ;
|
|---|
| 23 | N I,L
|
|---|
| 24 | S:'$G(N) N=1
|
|---|
| 25 | S L=+$O(DA(""),-1)
|
|---|
| 26 | S DA=$G(DA(N))
|
|---|
| 27 | F I=N+1:1:L S DA(I-N)=$G(DA(I))
|
|---|
| 28 | F I=L-N+1:1:L K DA(I)
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;=================
|
|---|
| 32 | ; $$IENS(File,DA)
|
|---|
| 33 | ;=================
|
|---|
| 34 | ;Return IENS given file# and DA array
|
|---|
| 35 | ;In:
|
|---|
| 36 | ; FIL = File or subfile #
|
|---|
| 37 | ; DA = DA array (any unneeded elements in the DA array are ignored)
|
|---|
| 38 | ;
|
|---|
| 39 | IENS(FIL,DA) ;
|
|---|
| 40 | N LEV,I,IENS,ERR
|
|---|
| 41 | Q:$G(FIL)="" ""
|
|---|
| 42 | S LEV=$$FLEV(FIL) Q:LEV="" ""
|
|---|
| 43 | ;
|
|---|
| 44 | ;Build IENS
|
|---|
| 45 | S IENS=$G(DA)_","
|
|---|
| 46 | F I=1:1:LEV S IENS=IENS_$G(DA(I))_","
|
|---|
| 47 | Q IENS
|
|---|
| 48 | ;
|
|---|
| 49 | ;=========================
|
|---|
| 50 | ; $$FNUM(Root,Flag)
|
|---|
| 51 | ;=========================
|
|---|
| 52 | ;Given file root, return File # from 2nd piece of header node.
|
|---|
| 53 | ;Also check that that file has a DD entry and a non-wp .01 field.
|
|---|
| 54 | ;Return null if error.
|
|---|
| 55 | ;In:
|
|---|
| 56 | ; ROOT = file root
|
|---|
| 57 | ; F [ D : generate dialog
|
|---|
| 58 | ;
|
|---|
| 59 | FNUM(ROOT,F) ;
|
|---|
| 60 | Q:$G(ROOT)="" ""
|
|---|
| 61 | N FIL
|
|---|
| 62 | S ROOT=$$CREF(ROOT)
|
|---|
| 63 | I $D(@ROOT@(0))[0 D:$G(F)["D" ERR^DIKCU2(404,"","","",ROOT) Q ""
|
|---|
| 64 | S FIL=+$P(@ROOT@(0),U,2)
|
|---|
| 65 | I '$$VFNUM^DIKCU1(FIL,$G(F)) Q ""
|
|---|
| 66 | Q FIL
|
|---|
| 67 | ;
|
|---|
| 68 | ;===============================
|
|---|
| 69 | ; $$FROOTDA(File,Flag,.L,.TRoot
|
|---|
| 70 | ;===============================
|
|---|
| 71 | ;Return global root of File; may include DA(1), DA(2), ... for subfiles
|
|---|
| 72 | ;Examples: ^DIZ(9999) and ^DIZ(9999,DA(1),"MULT1")
|
|---|
| 73 | ;In:
|
|---|
| 74 | ; FIL = file #
|
|---|
| 75 | ; FLAG [ O : return open root
|
|---|
| 76 | ; [ D : generate dialog
|
|---|
| 77 | ; starts with number : indicates offset to use for DA array
|
|---|
| 78 | ;Out:
|
|---|
| 79 | ; .L = level of file
|
|---|
| 80 | ; .TROOT = top level root
|
|---|
| 81 | ;
|
|---|
| 82 | FROOTDA(FIL,F,L,TROOT) ;
|
|---|
| 83 | I $G(FIL)="" S (L,TROOT)="" Q ""
|
|---|
| 84 | S F=$G(F)
|
|---|
| 85 | ;
|
|---|
| 86 | ;If top level, return "GL"
|
|---|
| 87 | I $D(^DIC(FIL,0,"GL"))#2 D Q TROOT
|
|---|
| 88 | . S L=0,TROOT=$S(F["O":^("GL"),1:$$CREF(^("GL")))
|
|---|
| 89 | ;
|
|---|
| 90 | ;Must be a subfile level, get mult nodes, and level
|
|---|
| 91 | N ERR,I,MFLD,ND,PAR,ROOT,SUB
|
|---|
| 92 | S SUB=FIL
|
|---|
| 93 | F L=0:1 S PAR=$G(^DD(SUB,0,"UP")) Q:'PAR D Q:$G(ERR)
|
|---|
| 94 | . S MFLD=$O(^DD(PAR,"SB",SUB,""))
|
|---|
| 95 | . S ND=$P($P($G(^DD(PAR,MFLD,0)),U,4),";")
|
|---|
| 96 | . I ND?." " S ERR=1 D:F["D" ERR^DIKCU2(502,PAR,"",MFLD) Q
|
|---|
| 97 | . S:ND'=+$P(ND,"E") ND=""""_ND_""""
|
|---|
| 98 | . S ND(L+1)=ND
|
|---|
| 99 | . S SUB=PAR
|
|---|
| 100 | I $G(ERR) S (L,TROOT)="" Q ""
|
|---|
| 101 | ;
|
|---|
| 102 | ;Build global root for subfile
|
|---|
| 103 | S (ROOT,TROOT)=$G(^DIC(SUB,0,"GL"))
|
|---|
| 104 | I ROOT="" D:F["D" ERR^DIKCU2(402,SUB) S L="" Q ""
|
|---|
| 105 | ;
|
|---|
| 106 | F I=L:-1:1 S ROOT=ROOT_"DA("_(I+F)_"),"_ND(I)_","
|
|---|
| 107 | S:F'["O" TROOT=$$CREF(TROOT)
|
|---|
| 108 | Q $S(F["O":ROOT,1:$$CREF(ROOT))
|
|---|
| 109 | ;
|
|---|
| 110 | CREF(X) ;Return closed root of X
|
|---|
| 111 | N F,L
|
|---|
| 112 | S L=$E(X,$L(X)),F=$E(X,1,$L(X)-1)
|
|---|
| 113 | Q $S(L="(":F,L=",":F_")",1:X)
|
|---|
| 114 | ;
|
|---|
| 115 | ;================
|
|---|
| 116 | ; $$FLEV(File,F)
|
|---|
| 117 | ;================
|
|---|
| 118 | ;Return the level of File
|
|---|
| 119 | ;In:
|
|---|
| 120 | ; FIL = file#
|
|---|
| 121 | ; F [ "D" : generate Dialog
|
|---|
| 122 | ;
|
|---|
| 123 | FLEV(FIL,F) ;
|
|---|
| 124 | Q:$G(FIL)="" ""
|
|---|
| 125 | ;
|
|---|
| 126 | N LEV
|
|---|
| 127 | F LEV=0:1 Q:$G(^DD(FIL,0,"UP"))="" S FIL=^("UP")
|
|---|
| 128 | I '$D(^DD(FIL)) D:$G(F)["D" ERR^DIKCU2(402,FIL) Q ""
|
|---|
| 129 | Q LEV
|
|---|
| 130 | ;
|
|---|
| 131 | ;=========================
|
|---|
| 132 | ; $$FLEVDIFF(File1,File2)
|
|---|
| 133 | ;=========================
|
|---|
| 134 | ;Find the difference in levels between File1 and File2.
|
|---|
| 135 | ;File1 is an ancestor of File2.
|
|---|
| 136 | ;In:
|
|---|
| 137 | ; FIL1 = File or subfile # of ancestor
|
|---|
| 138 | ; FIL2 = File or subfile #
|
|---|
| 139 | ;Returns: level difference; null if invalid input
|
|---|
| 140 | ;
|
|---|
| 141 | FLEVDIFF(FIL1,FIL2) ;
|
|---|
| 142 | Q:$G(FIL1)=""!($G(FIL2)="") ""
|
|---|
| 143 | ;
|
|---|
| 144 | N DIFF,FIL
|
|---|
| 145 | S FIL=FIL2
|
|---|
| 146 | F DIFF=0:1 Q:FIL=FIL1 S FIL=$G(^DD(FIL,0,"UP")) Q:FIL=""
|
|---|
| 147 | Q $S(FIL=FIL1:DIFF,1:"")
|
|---|
| 148 | ;
|
|---|
| 149 | ;===============================================
|
|---|
| 150 | ; SUBFILES(File,.Subfile#Array,.NodeArray,Flag)
|
|---|
| 151 | ;===============================================
|
|---|
| 152 | ;Build list of subfiles
|
|---|
| 153 | ;In:
|
|---|
| 154 | ; FIL = file #
|
|---|
| 155 | ; FLG = 1 (if wp subfiles should be returned)
|
|---|
| 156 | ;Out:
|
|---|
| 157 | ; .SB(subfile#) = parentFile#
|
|---|
| 158 | ; .MF(file#,multField#) = node
|
|---|
| 159 | ; .MF(file#,multField#,0) = subfile#
|
|---|
| 160 | ;
|
|---|
| 161 | SUBFILES(FIL,SB,MF,FLG) ;
|
|---|
| 162 | Q:$G(FIL)=""
|
|---|
| 163 | N SUB,MUL,ND
|
|---|
| 164 | ;
|
|---|
| 165 | ;Loop through "SB" nodes
|
|---|
| 166 | S SUB="" F S SUB=$O(^DD(FIL,"SB",SUB)) Q:'SUB D
|
|---|
| 167 | . S MUL=$O(^DD(FIL,"SB",SUB,0)) Q:'MUL
|
|---|
| 168 | . Q:$D(^DD(SUB,.01,0))[0 Q:$P(^(0),U,2)["W"&'$G(FLG)
|
|---|
| 169 | . ;
|
|---|
| 170 | . S ND=$P($P(^DD(FIL,MUL,0),U,4),";") Q:ND=""
|
|---|
| 171 | . S SB(SUB)=FIL,MF(FIL,MUL)=ND,MF(FIL,MUL,0)=SUB
|
|---|
| 172 | . ;
|
|---|
| 173 | . ;Make a recursive call to get all subfiles under file SUB
|
|---|
| 174 | . D SUBFILES(SUB,.SB,.MF,$G(FLG))
|
|---|
| 175 | Q
|
|---|
| 176 | ;
|
|---|
| 177 | ;============================
|
|---|
| 178 | ; SBINFO(Subfile,.NodeArray)
|
|---|
| 179 | ;============================
|
|---|
| 180 | ;Get info for Subfile
|
|---|
| 181 | ;In:
|
|---|
| 182 | ; SUB = subfile #
|
|---|
| 183 | ;Out:
|
|---|
| 184 | ; .MF(file#,multField#) = node
|
|---|
| 185 | ; .MF(file#,multField#,0) = subfile#
|
|---|
| 186 | ;
|
|---|
| 187 | SBINFO(SUB,MF) ;
|
|---|
| 188 | N ERR,MUL,ND,PAR
|
|---|
| 189 | F S PAR=$G(^DD(SUB,0,"UP")) Q:'PAR D Q:$G(ERR)
|
|---|
| 190 | . S MUL=$O(^DD(PAR,"SB",SUB,0)) I 'MUL S ERR=1 Q
|
|---|
| 191 | . S ND=$P($P(^DD(PAR,MUL,0),U,4),";") I ND="" S ERR=1 Q
|
|---|
| 192 | . S MF(PAR,MUL)=ND,MF(PAR,MUL,0)=SUB,SUB=PAR
|
|---|
| 193 | Q
|
|---|
| 194 | ;
|
|---|
| 195 | ;============================
|
|---|
| 196 | ; SELFILE(Root,TopFile,File)
|
|---|
| 197 | ;============================
|
|---|
| 198 | ;Prompt for file/subfile
|
|---|
| 199 | ;Out:
|
|---|
| 200 | ; .ROOT = open root of top level file
|
|---|
| 201 | ; .TOP = top level file #
|
|---|
| 202 | ; .FILE = (sub)file #
|
|---|
| 203 | ;
|
|---|
| 204 | SELFILE(ROOT,TOP,FILE) ;
|
|---|
| 205 | N %,C,D,DA,DDA,DI,DIAC,DIC,DICS,DIFILE,X,Y
|
|---|
| 206 | S (ROOT,TOP,FILE)=""
|
|---|
| 207 | D D^DICRW Q:Y<0
|
|---|
| 208 | ;
|
|---|
| 209 | ;Check if this is a new file
|
|---|
| 210 | I '$D(DIC) D Q:'$D(DIC)
|
|---|
| 211 | . N DG,DIE,DIK,DLAYGO,F,Z
|
|---|
| 212 | . D DIE^DIB
|
|---|
| 213 | . S:$D(DG) DIC=DG
|
|---|
| 214 | ;
|
|---|
| 215 | ;Check that file exists
|
|---|
| 216 | S DI=+$P($G(@(DIC_"0)")),U,2)
|
|---|
| 217 | I 'DI W $C(7),!,$$EZBLD^DIALOG(410,DIC_"0)"),! Q
|
|---|
| 218 | ;
|
|---|
| 219 | ;Get subfile, root, and top
|
|---|
| 220 | S FILE=$$SUB^DIKCU(DI) Q:FILE=""
|
|---|
| 221 | S ROOT=DIC,TOP=DI
|
|---|
| 222 | Q
|
|---|
| 223 | ;
|
|---|
| 224 | ;==============
|
|---|
| 225 | ; $$SUB(File#)
|
|---|
| 226 | ;==============
|
|---|
| 227 | ;Prompt for subfiles under file
|
|---|
| 228 | ;Returns: file or subfile #
|
|---|
| 229 | ; null : if user ^-out
|
|---|
| 230 | ;
|
|---|
| 231 | SUB(FIL) ;
|
|---|
| 232 | N D,DIC,DTOUT,DUOUT,QUIT,X,Y
|
|---|
| 233 | ;
|
|---|
| 234 | S DIC(0)="QEAI"
|
|---|
| 235 | S DIC("A")="Select Subfile: "
|
|---|
| 236 | S DIC("S")="N % S %=+$P(^(0),U,2) I %,$P($G(^DD(%,.01,0)),U,2)'[""W"""
|
|---|
| 237 | ;
|
|---|
| 238 | F Q:$O(^DD(+$G(FIL),"SB",0))'>0!$D(QUIT) D
|
|---|
| 239 | . S DIC="^DD("_FIL_","
|
|---|
| 240 | . D ^DIC
|
|---|
| 241 | . I X="" S QUIT=1 Q
|
|---|
| 242 | . I Y=-1 S QUIT=1 S FIL="" Q
|
|---|
| 243 | . S FIL=+$P(^DD(FIL,+Y,0),U,2)
|
|---|
| 244 | . W " (Subfile #"_FIL_")"
|
|---|
| 245 | Q FIL
|
|---|
| 246 | ;
|
|---|
| 247 | ;#401 File #|FILE| does not exist.
|
|---|
| 248 | ;#402 The global root of file #|FILE| is missing or not valid.
|
|---|
| 249 | ;#404 The File Header node of the file stored at |1| lacks a file number.
|
|---|
| 250 | ;#410 Missing or incomplete global node |1|.
|
|---|
| 251 | ;#502 Field# |FIELD| in file# |FILE| has a corrupted definition.
|
|---|
