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

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1DIKCP2 ;SFISC/MKO-PRINT INDEX(ES) ;9:39 AM 5 Aug 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4LFILE ;Format list of indexes and print; Come here from LFILE^DIKCP
5 N LN,NAM,NO,TXT,XR,XRL
6 S TXT=0,TXT(0)=""
7 ;
8 I $G(FLD)="" S NAM="" F S NAM=$O(^DD("IX","BB",FIL,NAM)) Q:NAM="" D
9 . S XR=0
10 . F S XR=$O(^DD("IX","BB",FIL,NAM,XR)) Q:'XR D ADDXR(XR,.TXT,FLAG)
11 E D
12 . S XR=0
13 . F S XR=$O(^DD("IX","F",FIL,FLD,XR)) Q:'XR D
14 .. Q:$G(^DD("IX",XR,0))?."^" S NAM=$P(^(0),U,2)
15 .. S:NAM="" NAM=" <no name"_$G(NO)_">",NO=$G(NO)+1
16 .. S XRL(NAM,XR)=""
17 . S NAM="" F S NAM=$O(XRL(NAM)) Q:NAM="" D
18 .. S XR=0 F S XR=$O(XRL(NAM,XR)) Q:'XR D ADDXR(XR,.TXT,FLAG)
19 Q:TXT(0)=""
20 ;
21 D WRAP^DIKCU2(.TXT,WID)
22 D WRLN($G(LAB)_TXT(0),LM,.PAGE) Q:PAGE(U)
23 F LN=1:1 Q:'$D(TXT(LN)) D WRLN(TXT(LN),LM+$L(LAB),.PAGE) Q:PAGE(U)
24 Q
25 ;
26ADDXR(XR,TXT,FLAG) ;Add field list and xref name to TXT array
27 N CRV,FIL,FLD,FLDNAM,FND,NAM,RTYP,STR,XR0
28 S XR0=$G(^DD("IX",XR,0))
29 Q:XR0?."^" Q:FLAG'[$P(XR0,U,6)
30 ;
31 S:$G(TXT(TXT))]"" TXT(TXT)=TXT(TXT)_", "
32 S NAM=$P(XR0,U,2)
33 ;
34 I TYP=1 D
35 . S STR=NAM_$C(0)_"(#"_XR_")"
36 . S RTYP=$P(XR0,U,8)
37 . I "I"'[RTYP D
38 .. S STR=STR_" ("_$TR($$EXTERNAL^DILFD(.11,.5,"",RTYP)," ",$C(0))
39 .. S STR=STR_" #"_$P(XR0,U)_")"
40 ;
41 E D
42 . S CRV=0 F S CRV=$O(^DD("IX",XR,11.1,CRV)) Q:'CRV D
43 .. Q:$P($G(^DD("IX",XR,11.1,CRV,0)),U,2)'="F"
44 .. S FIL=$P(^DD("IX",XR,11.1,CRV,0),U,3),FLD=$P(^(0),U,4)
45 .. Q:'FIL Q:'FLD
46 .. S FLDNAM=$P($G(^DD(FIL,FLD,0)),U) Q:FLDNAM=""
47 .. D:$G(FND) ADDSTR("& ",.TXT) D ADDSTR(FLDNAM_" ",.TXT)
48 .. S FND=1
49 . S STR="("_NAM_")"
50 . ;
51 D ADDSTR(STR,.TXT)
52 Q
53 ;
54ADDSTR(X,TXT) ;Add string X to the TXT array
55 I $L(TXT(TXT))+$L(X)>250 S TXT=TXT+1,TXT(TXT)=""
56 S TXT(TXT)=TXT(TXT)_X
57 Q
58 ;
59WRLN(TXT,TAB,PAGE,KWN) ;Write a line of text
60 ;See ^DIKCP for documentation
61 N X
62 S PAGE(U)=""
63 ;
64 ;Do paging, if necessary
65 I $D(PAGE("H"))#2,$G(IOSL,24)-2-$G(PAGE("B"))-$G(KWN)'>$Y D Q:PAGE(U)
66 . I PAGE("H")?1"W ".E X PAGE("H") Q
67 . I $E($G(IOST,"C"))="C" D Q:PAGE(U)
68 .. W $C(7) R X:$G(DTIME,300) I X=U!'$T S PAGE(U)=1
69 . W @$G(IOF,"#"),PAGE("H")
70 ;
71 ;Write text
72 W !?$G(TAB),$TR($G(TXT),$C(0)," ")
73 Q
Note: See TracBrowser for help on using the repository browser.