| 1 | DIDG ;SFISC/RWF-GLOBAL MAP ;1:24 PM 1 Mar 2002
|
|---|
| 2 | ;;22.0;VA FileMan;**105**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | K W S DJ(Z)=D0,F=0,W=F(Z),M=1,DP=0
|
|---|
| 5 | W !
|
|---|
| 6 | UP I $D(^DD(W,0,"UP")) S Y=^("UP"),N=$O(^DD(Y,"SB",W,0)) I $D(^DD(Y,N,0)) S F=F+1,W(F)=$P($P(^(0),U,4),";",1),W=Y G UP
|
|---|
| 7 | S W=$S($D(^DIC(W,0,"GL")):^("GL"),1:"^("),Y=0 F N=F:-1:1 S W=W_"D"_Y_","_$S(+W(N)=W(N):W(N),1:""""_W(N)_"""")_",",Y=Y+1
|
|---|
| 8 | S DID(Z-1)=W K W
|
|---|
| 9 | ;
|
|---|
| 10 | L S DN(Z)=""
|
|---|
| 11 | A S DN(Z)=$O(^DD(F(Z),"GL",DN(Z))),DP(0)=0 I DN(Z)="" D POP Q
|
|---|
| 12 | S DID(Z)=DID(Z-1)_"D"_(F+Z-1)_","_DN(Z) I $O(^DD(F(Z),"GL",DN(Z),""))'=0 S W=DID(Z)_")=" W ! D WL Q:M=U
|
|---|
| 13 | B S DP=$O(^DD(F(Z),"GL",DN(Z),DP)) G PUSH:DP=0,A:DP=""
|
|---|
| 14 | S DF=$O(^DD(F(Z),"GL",DN(Z),DP,0))
|
|---|
| 15 | I DP(0)+1<DP F I1=DP(0)+1:1:DP-1 S W=" ^ " D WL Q:M=U
|
|---|
| 16 | S N=^DD(F(Z),DF,0),DP(0)=DP
|
|---|
| 17 | S X=$P(N,U,2) I +X S Z=Z+1,F(Z)=+X D L G B
|
|---|
| 18 | S W="(#"_DF_") "_$P(N,U,1)_" ["_DP
|
|---|
| 19 | F Y="F","S","D","N","P","W","V","K" I X[Y S W=W_Y S:Y="P" W=W_":"_+$P(X,"P",2)
|
|---|
| 20 | S W=W_"] ^ " D WL Q:M=U G B
|
|---|
| 21 | ;
|
|---|
| 22 | PUSH S N=$O(^DD(F(Z),"GL",DN(Z),DP,0)) S:N="" N=-1 S Y=^DD(F(Z),N,0),DID(Z)=DID(Z)_","
|
|---|
| 23 | W !,DID(Z)_"0)=^"_$P(Y,U,2)_"^^ (#",N,") "_$P(Y,U,1) S Z=Z+1,F(Z)=+$P(Y,U,2)
|
|---|
| 24 | D L Q:M=U G A
|
|---|
| 25 | ;
|
|---|
| 26 | POP S Z=Z-1,DID(Z)=$E(DID(Z),1,$L(DID(Z))-1) Q:Z K DN,W,DP,DG,DID S DN=0 W ! Q
|
|---|
| 27 | ;
|
|---|
| 28 | END ;
|
|---|
| 29 | S S=0,M=1
|
|---|
| 30 | T1 S S=S+1 D:$Y+3>IOSL HDR Q:M=U
|
|---|
| 31 | W !!,$S(S<4:$P("INPU^PRIN^SOR",U,S)_"T TEMPLATE(S):",1:"FORM(S)/BLOCK(S):")
|
|---|
| 32 | S DFF="^DI"_$P("E^PT^BT^ST(.403)",U,S),DA=""
|
|---|
| 33 | F S DA=$O(@DFF@("F"_F(1),DA)) Q:DA="" D Q:M=U
|
|---|
| 34 | . S DUB=0 F S DUB=$O(@DFF@("F"_F(1),DA,DUB)) Q:DUB'>0 D Q:M=U
|
|---|
| 35 | .. I $D(@DFF@(DUB,0))#2 S %1=^(0) D TEMPL
|
|---|
| 36 | K %1 Q:M=U G T1:S<4
|
|---|
| 37 | Q Q
|
|---|
| 38 | TEMPL I $Y+3>IOSL D HDR Q:M=U
|
|---|
| 39 | N % S %=$S($D(^("ROU")):"Compiled: "_^("ROU"),'$D(^("ROU"))&($D(^("ROUOLD"))):"Previously Compiled: "_^("ROUOLD"),1:"")
|
|---|
| 40 | I %]"",DFF["DIBT" S %=%_"*"
|
|---|
| 41 | I DFF'["DIST" W !,DFF,"("_DUB_")= ",$P(%1,U)_" "_%
|
|---|
| 42 | E D FORM
|
|---|
| 43 | Q
|
|---|
| 44 | WL I $Y+4>IOSL S %1=W D HD Q:M=U S W=%1 I W[DID(Z) S W=""
|
|---|
| 45 | F I=1:1 S Y=$P(W," ",I)_" " Q:$P(W," ",I,99)="" W:$X+$L(Y)+2>IOM !,?$L(DID(Z)),"==>" W Y
|
|---|
| 46 | Q
|
|---|
| 47 | W W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-5<M:IOM-5-$L(W),1:M),S S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1),S Q:%Y="" S W=%Y G W
|
|---|
| 48 | ;
|
|---|
| 49 | HD S DC=DC+1 D ^DIDH Q:M=U W !,DID(Z),")= " Q
|
|---|
| 50 | ;
|
|---|
| 51 | HDR ;
|
|---|
| 52 | S DC=DC+1 I IOST?1"C".E W $C(7) R M:DTIME S:'$T M=U Q:M=U
|
|---|
| 53 | H1 W:$D(DIFF)&($Y) @IOF S DIFF=1 W "TEMPLATE LIST -- FILE #"_DIB,?(IOM-20),$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)_" PAGE "_DC
|
|---|
| 54 | S M="",$P(M,"-",IOM)="" W !,M
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | FORM ;
|
|---|
| 58 | W !,"^DIST(.403,"_DUB_")= ",$P(%1,U)_" "_%
|
|---|
| 59 | ;
|
|---|
| 60 | N B,L,P
|
|---|
| 61 | S L=1,L(1)=U
|
|---|
| 62 | S P=0 F S P=$O(^DIST(.403,DUB,40,P)) Q:'P D Q:M=U
|
|---|
| 63 | . Q:$D(^DIST(.403,DUB,40,P,0))[0 S B=$P(^(0),U,2) D:B BLOCK Q:M=U
|
|---|
| 64 | . S B=0 F S B=$O(^DIST(.403,DUB,40,P,40,B)) Q:'B D BLOCK Q:M=U
|
|---|
| 65 | W !
|
|---|
| 66 | Q
|
|---|
| 67 | BLOCK ;
|
|---|
| 68 | N I
|
|---|
| 69 | F I=1:1:L I L(I)[(U_B_U) G BLOCKQ
|
|---|
| 70 | S:$L(L)+$L(B)+1>245 L=L+1,L(L)=U S L(L)=L(L)_B_U
|
|---|
| 71 | Q:$D(^DIST(.404,B,0))[0 S %1=^(0)
|
|---|
| 72 | ;
|
|---|
| 73 | I $Y+3>IOSL D HDR Q:M=U
|
|---|
| 74 | W !?2,"^DIST(.404,"_B_")= ",$P(%1,U)
|
|---|
| 75 | BLOCKQ Q
|
|---|
