source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKCP3.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1DIKCP3 ;SFISC/MKO-PRINT INDEX(ES) ;9:21 PM 7 Dec 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PRFILE(FIL,FLD,FLAG,PAGE,FHDR) ;Print Traditional cross-references on a file
6 Q:'$G(FIL)
7 N HDR,NAM,NO,XR
8 I $G(FLAG)'["i" N LM,TS,TYP,WID D INIT^DIKCP
9 ;
10 ;If field is not specified, print all xrefs on field
11 I $G(FLD)="" D
12 . ;Build list of xrefs sorted by name
13 . K ^TMP("DIKCP3",$J)
14 . S FLD=0 F S FLD=$O(^DD(FIL,"IX",FLD)) Q:'FLD D
15 .. S XR=0 F S XR=$O(^DD(FIL,FLD,1,XR)) Q:'XR D
16 ... Q:$D(^DD(FIL,FLD,1,XR))<9 S NAM=$P($G(^(XR,0)),U,2)
17 ... S:NAM="" NAM="~~"_$G(NO),NO=$G(NO)+1
18 ... S ^TMP("DIKCP3",$J,NAM,FLD,XR)=""
19 . ;
20 . ;Loop through sorted list and print
21 . S NAM="" F S NAM=$O(^TMP("DIKCP3",$J,NAM)) Q:NAM="" D Q:PAGE(U)
22 .. S FLD=0 F S FLD=$O(^TMP("DIKCP3",$J,NAM,FLD)) Q:'FLD D Q:PAGE(U)
23 ... S XR=0 F S XR=$O(^TMP("DIKCP3",$J,NAM,FLD,XR)) Q:'XR D Q:PAGE(U)
24 .... I '$G(FHDR) D FHDR^DIKCP(FIL,FLAG,.PAGE,.FHDR) Q:PAGE(U)
25 .... I '$G(HDR) D HDR(FIL,FLAG,LM,.PAGE,.HDR) Q:PAGE(U)
26 .... D PRINDEX(FIL,FLD,XR,FLAG,.PAGE) Q:PAGE(U)
27 .... D WRLN("",0,.PAGE) Q:PAGE(U)
28 .... I FLAG'["S" D WRLN("",0,.PAGE)
29 . K ^TMP("DIKCP3",$J)
30 ;
31 ;Else print cross-references on specific field
32 E S XR=0 F S XR=$O(^DD(FIL,FLD,1,XR)) Q:'XR D Q:PAGE(U)
33 . I '$G(FHDR) D FHDR^DIKCP(FIL,FLAG,.PAGE,.FHDR) Q:PAGE(U)
34 . I '$G(HDR) D HDR(FIL,FLAG,LM,.PAGE,.HDR) Q:PAGE(U)
35 . D PRINDEX(FIL,FLD,XR,FLAG,.PAGE) Q:PAGE(U)
36 . D WRLN("",0,.PAGE) Q:PAGE(U)
37 . I FLAG'["S" D WRLN("",0,.PAGE)
38 Q
39 ;
40PRINDEX(FIL,FLD,XR,FLAG,PAGE) ;Print a specific index
41 Q:'$G(FIL)!'$G(FLD)!'$G(XR)
42 N ND,WFLAG
43 I $G(FLAG)'["i" N LM,TYP,TS,WID D INIT^DIKCP
44 ;
45 ;Print first line of information
46 D FL(FIL,FLD,XR,WID,LM,TS,TYP,.PAGE) Q:PAGE(U)
47 ;
48 ;Print Field
49 D WLP^DIKCP1("Field: ",$P($G(^DD(FIL,FLD,0)),U)_" ("_FIL_","_FLD_")",WID,LM+TS,0,.PAGE)
50 Q:PAGE(U)
51 ;
52 ;For Triggers, print triggered field
53 I $P($G(^DD(FIL,FLD,1,XR,0)),U,3)["TRIG" D Q:PAGE(U)
54 . N LAB,TFIL,TFLD
55 . S TFIL=$P(^DD(FIL,FLD,1,XR,0),U,4),TFLD=$P(^(0),U,5)
56 . S LAB="Triggered Field: "
57 . D WLP^DIKCP1(LAB,$P($G(^DD(TFIL,TFLD,0)),U)_" ("_TFIL_","_TFLD_")",WID-$L(LAB),LM+TS+$L(LAB),"",.PAGE)
58 ;
59 ;Print Description
60 I $O(^DD(FIL,FLD,1,XR,"%D",0)) D Q:PAGE(U)
61 . D WRWP^DIKCP1($NA(^DD(FIL,FLD,1,XR,"%D")),LM,WID,"Description: ",TS,.PAGE)
62 I FLAG'["S" D WRLN("",0,.PAGE) Q:PAGE(U)
63 ;
64 ;Print xref nodes
65 K WFLAG
66 S ND=0 F S ND=$O(^DD(FIL,FLD,1,XR,ND)) Q:ND="" D Q:PAGE(U)
67 . Q:ND="%D"!(ND="DT")
68 . N TXT
69 . S TXT(0)=ND_")= "
70 . S TXT(1)=^DD(FIL,FLD,1,XR,ND)
71 . I FLAG'["S",ND,$G(WFLAG) D WRLN("",0,.PAGE) Q:PAGE(U)
72 . D WLP^DIKCP1("",.TXT,WID,LM+TS,1,.PAGE,.WFLAG)
73 Q
74 ;
75FL(FIL,FLD,XR,WID,LM,TS,TYP,PAGE) ;Print first line
76 N NAME,SP,TYPE,TXT,WF,XR0
77 ;
78 S SP=$J("",4)
79 S XR0=$G(^DD(FIL,FLD,1,XR,0)) Q:XR0?."^"
80 S NAME=$P(XR0,U,2)
81 S TYPE=$P(XR0,U,3) S:TYPE="" TYPE="REGULAR"
82 S TXT=NAME_SP_TYPE
83 ;
84 I $P(XR0,U),$P(XR0,U)'=FIL D
85 . S TXT=TXT_SP_"WHOLE"_$C(0)_"FILE"_$C(0)_"(#"_$P(XR0,U)_")"
86 ;
87 ;Print first line
88 D WRPHI^DIKCP1(TXT,WID,LM,TS,0,.PAGE)
89 Q
90 ;
91HDR(FIL,FLAG,LM,PAGE,HDR) ;Print header
92 I FLAG'["M",FLAG'["R",FLAG'["F" Q
93 D WRLN("Traditional Cross-References:",LM,.PAGE,2) Q:PAGE(U)
94 D WRLN("",0,.PAGE)
95 S HDR=1
96 Q
97 ;
98 ;
99WRLN(TXT,TAB,PAGE,KWN) ;Write a line of text
100 ;See ^DIKCP for documentation
101 N X
102 S PAGE(U)=""
103 ;
104 ;Do paging, if necessary
105 I $D(PAGE("H"))#2,$G(IOSL,24)-2-$G(PAGE("B"))-$G(KWN)'>$Y D Q:PAGE(U)
106 . I PAGE("H")?1"W ".E X PAGE("H") Q
107 . I $E($G(IOST,"C"))="C" D Q:PAGE(U)
108 .. W $C(7) R X:$G(DTIME,300) I X=U!'$T S PAGE(U)=1
109 . W @$G(IOF,"#"),PAGE("H")
110 ;
111 ;Write text
112 W !?$G(TAB),$TR($G(TXT),$C(0)," ")
113 Q
Note: See TracBrowser for help on using the repository browser.