source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKK1.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1DIKK1 ;SFISC/MKO-CHECK KEY INTEGRITY ;9:19 AM 5 Feb 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;========================
6 ; LOADALL(File,Flag,.MF)
7 ;========================
8 ;Load info about all keys on a file. Use the "B" xref on the Key file.
9 ;In:
10 ; KFIL = File # [.31,.01]
11 ; FLAG [ "s" : don't include subfile under file
12 ;Out:
13 ; ^TMP("DIKK",$J,keyFile#,file#) = levDif(keyfile,file) (if > 0)
14 ; ^openRootDA
15 ; ... file#,field#) = S X=$P($G(...),U,n)
16 ; or S X=$E($G(...),m,n)
17 ;
18 ; ^TMP("DIKK",$J,"UI",file[.01],ui#) = key#
19 ; ^TMP("DIKK",$J,"UIR",rFile[.51],ui#) = key#
20 ;
21 ; MF(file#,mField#) = multiple node
22 ; MF(file#,mField#,0) = subfile#
23 ;
24LOADALL(KFIL,FLAG,MF) ;
25 N FLD,KEY,ROOT
26 ;
27 ;Get info for all keys on this file
28 S KEY=0
29 F S KEY=$O(^DD("KEY","B",KFIL,KEY)) Q:'KEY D LOADKEY(KEY,.ROOT)
30 Q:$G(FLAG)["s"
31 ;
32 ;Make a recursive call to get subfiles under KFIL
33 N CHK,FIL,MFLD,PAR,SB
34 D SUBFILES^DIKCU(KFIL,.SB,.MF)
35 S SB=0 F S SB=$O(SB(SB)) Q:'SB D
36 . D LOADALL(SB,"s") Q:'$D(^TMP("DIKK",$J,SB))
37 . ;
38 . ;Set CHK(subfile)="" for subfile and its antecedents
39 . S PAR=SB F Q:$D(CHK(PAR)) S CHK(PAR)=1,PAR=$G(SB(PAR)) Q:PAR=""
40 ;
41 ;Use the CHK array to get rid of unneeded elements in MF
42 S FIL=0 F S FIL=$O(MF(FIL)) Q:'FIL D
43 . S MFLD=0 F S MFLD=$O(MF(FIL,MFLD)) Q:'MFLD D
44 .. K:'$D(CHK(MF(FIL,MFLD,0))) MF(FIL,MFLD)
45 Q
46 ;
47 ;=====================
48 ; LOADFLD(File,Field)
49 ;=====================
50 ;Load info for all keys of which a field is a part.
51 ;
52LOADFLD(FIL,FLD) ;
53 N KEY
54 S KEY=0 F S KEY=$O(^DD("KEY","F",FIL,FLD,KEY)) Q:'KEY D LOADKEY(KEY)
55 Q
56 ;
57 ;===================
58 ; LOADKEY(Key,Root)
59 ;===================
60 ;Load info about a key.
61 ;In:
62 ; KEY = Key #
63 ; .OROOT = Open root of File of Key [.31,.01] (optional) (also output)
64 ;Out:
65 ; .OROOT = Open root of File of Key [.31,.01]
66 ; ^TMP (see LOADALL above)
67 ;
68LOADKEY(KEY,OROOT) ;
69 N DEC,FIL,FLD,FLDN,KFIL,LDIF,UI,UIFIL,UIRFIL
70 ;
71 ;Get key data
72 S KFIL=$P($G(^DD("KEY",KEY,0)),U),UI=$P($G(^(0)),U,4) Q:'KFIL!'UI
73 ;
74 ;Get info about UI
75 S UIFIL=$P($G(^DD("IX",UI,0)),U),UIRFIL=$P(^(0),U,9) Q:'UIFIL!'UIRFIL
76 Q:$D(^TMP("DIKK",$J,"UI",UIFIL,UI)) S ^(UI)=KEY
77 S ^TMP("DIKK",$J,"UIR",UIRFIL,UI)=KEY
78 ;
79 ;Get root of file [.31,.01]
80 I $G(OROOT)="" S OROOT=$$FROOTDA^DIKCU(KFIL,"O")_"DA," Q:OROOT="DA,"
81 ;
82 ;Loop through fields in key; get data extraction code
83 S FLDN=0 F S FLDN=$O(^DD("KEY",KEY,2,FLDN)) Q:'FLDN D
84 . Q:'$D(^DD("KEY",KEY,2,FLDN,0)) S FLD=$P(^(0),U),FIL=$P(^(0),U,2)
85 . Q:'FLD!'FIL Q:$D(^TMP("DIKK",$J,KFIL,FIL,FLD))#2
86 . ;
87 . I FIL'=KFIL N OROOT D Q:$G(OROOT)=""
88 .. I $D(^TMP("DIKK",$J,KFIL,FIL))#2 S LDIF=+^(FIL),OROOT=U_$P(^(FIL),U,2,999)
89 .. E D
90 ... S LDIF=$$FLEVDIFF^DIKCU(FIL,KFIL) Q:'LDIF
91 ... S OROOT=$$FROOTDA^DIKCU(FIL,LDIF_"O") Q:OROOT=""
92 ... S OROOT=OROOT_"DA("_LDIF_"),"
93 ... S ^TMP("DIKK",$J,KFIL,FIL)=LDIF_OROOT
94 . ;
95 . S DEC=$$DEC(FIL,FLD,OROOT) Q:DEC=""
96 . S ^TMP("DIKK",$J,KFIL,FIL,FLD)=DEC
97 ;
98 Q
99 ;
100 ;==============================
101 ; $$DEC(File#,Field#,OpenRoot)
102 ;==============================
103 ;Return code that sets X=data from file; examples:
104 ; S X=$P($G(^DIZ(1000,DA(2),"m1",DA(1),"m2",DA,0)),U,3)
105 ; S X=$E($G(^DIZ(1000,DA(2),"m1",DA(1),"m2",DA,0)),1,245)
106 ;In:
107 ; FIL = File #
108 ; FLD = Field #
109 ; OROOT = Open root of record (with DA strings) (optional)
110 ;
111DEC(FIL,FLD,OROOT) ;Get data extraction code
112 N ND,PC
113 S PC=$P($G(^DD(FIL,FLD,0)),U,4)
114 S ND=$P(PC,";"),PC=$P(PC,";",2) Q:ND?." " "" Q:"0 "[PC ""
115 S:ND'=+$P(ND,"E") ND=""""_ND_""""
116 ;
117 I $G(OROOT)="" S OROOT=$$FROOTDA^DIKCU(FIL,"O")_"DA," Q:OROOT="DA," ""
118 I PC Q "S X=$P($G("_OROOT_ND_")),U,"_PC_")"
119 E Q "S X=$E($G("_OROOT_ND_")),"_+$E(PC,2,999)_","_$P(PC,",",2)_")"
120 ;
Note: See TracBrowser for help on using the repository browser.