| 1 | DIKCP2 ;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.
|
|---|
| 4 | LFILE ;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 | ;
|
|---|
| 26 | ADDXR(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 | ;
|
|---|
| 54 | ADDSTR(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 | ;
|
|---|
| 59 | WRLN(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
|
|---|
