| 1 | DIWF ;SFISC/GFT-FORMS PRINT ;2/24/93 14:33
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D DT^DICRW,DICS,L S DIC("S")=DIC("S")_" I "_L
|
|---|
| 5 | S DIC="^DIC(",DIC(0)="AEQMZ",DIC("A")="Select Document File: "
|
|---|
| 6 | D ^DIC K DIC Q:Y<0
|
|---|
| 7 | FINDWORD X L I '$T S Y=-1 G Q
|
|---|
| 8 | S DJ=%,DIC=DIWF,D=$O(^DD(DIWFN,"SB",%,0)) S:D="" D=-1 Q:'$D(^DD(DIWFN,D,0)) S D=$P($P(^(0),U,4),";") S:+D'=D D=""""_D_"""" S DIWF=DIWF_"DIWFN,"_D_","
|
|---|
| 9 | S D=0 F S D=$O(^DD(DIWFN,D)) Q:D'>0 I $D(^(D,0)),$P(^(0),U,3)="DIC(" S DIWF(0)=D Q
|
|---|
| 10 | S:D="" D=-1
|
|---|
| 11 | DOC S DIC(0)="AEQM" D ^DIC G Q:Y<0
|
|---|
| 12 | I $D(DIWF(0)) S D=$P(^DD(DIWFN,DIWF(0),0),U,4),%=$P(D,";",1) I @("$D("_DIC_+Y_",%))") S D=$P(D,";",2),X=$S(D:$P(^(%),U,D),1:$E(^(%),+$E(D,2,9),+$P(D,",",2))) S:X DIWF(1)=X
|
|---|
| 13 | S DIWFN=+Y I @("$O("_DIWF_"0))'>0") W $C(7),!?7,"'"_$P(Y,U,2),"' HAS NO '"_$P(^DD(DJ,.01,0),U,1)_"' TEXT!",! G DOC
|
|---|
| 14 | EN2 ;
|
|---|
| 15 | I $O(@(DIWF_"0)"))'>0 S Y=-1 G Q
|
|---|
| 16 | S DIC(0)="AIQEMZ",DIC="^DIC(",DIC("A")="Print from what FILE: "
|
|---|
| 17 | I $D(DIWF(1)) S DIC(0)="ZIF",X=DIWF(1)
|
|---|
| 18 | D DICS:'$D(DIWF(1)),^DIC K DIC G Q:Y<0,Q:'$D(^DIC(+Y,0,"GL")) S DIC=^("GL")
|
|---|
| 19 | S %=1 I $D(BY)[0 W !,"WANT EACH ENTRY ON A SEPARATE PAGE" D YN^DICN G Q:%<1
|
|---|
| 20 | S L=0,DHD="@",FLDS="",DHIT="X "_$P("^UTILITY($J,1):$Y,",9,%)_"DIWFX D ^DIWW",DIWFX="S DIWF=""?W"",DIWL=1,DIWR=IOM,D=0 F S D=$O("_DIWF_"D)) S:D="""" D=-1 Q:D'>0 I $D(^(D,0)) S X=^(0) D ^DIWP" K DIWF D EN1^DIP
|
|---|
| 21 | Q K L,DIWF,DIWFN,DIWFX,DIFILE,DIAC Q
|
|---|
| 22 | ;
|
|---|
| 23 | EN1 ;
|
|---|
| 24 | I DIC Q:'$D(^DIC(+DIC,0)) S Y=DIC D L G FINDWORD
|
|---|
| 25 | I @("$D("_DIC_"0))") S DIC=+$P(^(0),U,2) G EN1
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DICS S DIC("S")="S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %" Q
|
|---|
| 29 | ;
|
|---|
| 30 | L S L="I $D(^DIC(+Y,0,""GL"")) S DIWF=^(""GL"") I $D(@(DIWF_""0)"")) S DIWFN=+$P(^(0),U,2) I $D(^DD(DIWFN,""SB"")) S %=0 F S %=$O(^DD(DIWFN,""SB"",%)) S:%="""" %=-1 Q:%<0 I $P(^DD(%,.01,0),U,2)[""W"" Q"
|
|---|
