DIWF.m

DIWF ;SFISC/GFT-FORMS PRINT ;2/24/93  14:33

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 D DT^DICRW,DICS,L S DIC("S")=DIC("S")_" I  "_L

 S DIC="^DIC(",DIC(0)="AEQMZ",DIC("A")="Select Document File: "

 D ^DIC K DIC Q:Y<0

FINDWORD X L I '$T S Y=-1 G Q

 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_","

 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

 S:D="" D=-1

DOC S DIC(0)="AEQM" D ^DIC G Q:Y<0

 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

 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

EN2 ;

 I $O(@(DIWF_"0)"))'>0 S Y=-1 G Q

 S DIC(0)="AIQEMZ",DIC="^DIC(",DIC("A")="Print from what FILE: "

 I $D(DIWF(1)) S DIC(0)="ZIF",X=DIWF(1)

 D DICS:'$D(DIWF(1)),^DIC K DIC G Q:Y<0,Q:'$D(^DIC(+Y,0,"GL")) S DIC=^("GL")

 S %=1 I $D(BY)[0 W !,"WANT EACH ENTRY ON A SEPARATE PAGE" D YN^DICN G Q:%<1

 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

Q K L,DIWF,DIWFN,DIWFX,DIFILE,DIAC Q

 ;

EN1 ;

 I DIC Q:'$D(^DIC(+DIC,0))  S Y=DIC D L G FINDWORD

 I @("$D("_DIC_"0))") S DIC=+$P(^(0),U,2) G EN1

 Q

 ;

DICS S DIC("S")="S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %" Q

 ;

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"

DIWF      ;SFISC/GFT-FORMS PRINT ;2/24/93  14:33

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        DO DT^DICRW

           DO DICS

           DO L

           SET DIC("S")=DIC("S")_" I  "_L

 +4        SET DIC="^DIC("

           SET DIC(0)="AEQMZ"

           SET DIC("A")="Select Document File: "

 +5        DO ^DIC

           KILL DIC

           IF Y<0

               QUIT 

FINDWORD   XECUTE L

           IF '$TEST

               SET Y=-1

               GOTO Q

 +1        SET DJ=%

           SET DIC=DIWF

           SET D=$ORDER(^DD(DIWFN,"SB",%,0))

           IF D=""

               SET D=-1

           IF '$DATA(^DD(DIWFN,D,0))

               QUIT 

           SET D=$PIECE($PIECE(^(0),U,4),";")

           IF +D'=D

               SET D=""""_D_""""

           SET DIWF=DIWF_"DIWFN,"_D_","

 +2        SET D=0

           FOR 

               SET D=$ORDER(^DD(DIWFN,D))

               IF D'>0

                   QUIT 

               IF $DATA(^(D,0))

                   IF $PIECE(^(0),U,3)="DIC("

                       SET DIWF(0)=D

                       QUIT 

 +3        IF D=""

               SET D=-1

DOC        SET DIC(0)="AEQM"

           DO ^DIC

           IF Y<0

               GOTO Q

 +1        IF $DATA(DIWF(0))

               SET D=$PIECE(^DD(DIWFN,DIWF(0),0),U,4)

               SET %=$PIECE(D,";",1)

               IF @("$D("_DIC_+Y_",%))")

                   SET D=$PIECE(D,";",2)

                   SET X=$SELECT(D:$PIECE(^(%),U,D),1:$EXTRACT(^(%),+$EXTRACT(D,2,9),+$PIECE(D,",",2)))

                   IF X

                       SET DIWF(1)=X

 +2        SET DIWFN=+Y

           IF @("$O("_DIWF_"0))'>0")

               WRITE $CHAR(7),!?7,"'"_$PIECE(Y,U,2),"' HAS NO '"_$PIECE(^DD(DJ,.01,0),U,1)_"' TEXT!",!

               GOTO DOC

EN2       ;

 +1        IF $ORDER(@(DIWF_"0)"))'>0

               SET Y=-1

               GOTO Q

 +2        SET DIC(0)="AIQEMZ"

           SET DIC="^DIC("

           SET DIC("A")="Print from what FILE: "

 +3        IF $DATA(DIWF(1))

               SET DIC(0)="ZIF"

               SET X=DIWF(1)

 +4        IF '$DATA(DIWF(1))

               DO DICS

           DO ^DIC

           KILL DIC

           IF Y<0

               GOTO Q

           IF '$DATA(^DIC(+Y,0,"GL"))

               GOTO Q

           SET DIC=^("GL")

 +5        SET %=1

           IF $DATA(BY)[0

               WRITE !,"WANT EACH ENTRY ON A SEPARATE PAGE"

               DO YN^DICN

               IF %<1

                   GOTO Q

 +6        SET L=0

           SET DHD="@"

           SET FLDS=""

           SET DHIT="X "_$PIECE("^UTILITY($J,1):$Y,",9,%)_"DIWFX D ^DIWW"

           SET 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"

           KILL DIWF

           DO EN1^DIP

Q          KILL L,DIWF,DIWFN,DIWFX,DIFILE,DIAC

           QUIT 

 +1       ;

EN1       ;

 +1        IF DIC

               IF '$DATA(^DIC(+DIC,0))

                   QUIT 

               SET Y=DIC

               DO L

               GOTO FINDWORD

 +2        IF @("$D("_DIC_"0))")

               SET DIC=+$PIECE(^(0),U,2)

               GOTO EN1

 +3        QUIT 

 +4       ;

DICS       SET DIC("S")="S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %"

           QUIT 

 +1       ;

L          SET 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"