| [613] | 1 | DIS2 ;SFISC/GFT-SEARCH, TEMPLATES & COMPUTED FIELDS;4JUN2005
|
|---|
| 2 | ;;22.0;VA FileMan;**6,144**;Mar 30, 1999;Build 5
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | K DISV G G:'DUZ
|
|---|
| 5 | 0 D K DIRUT,DIROUT I $D(DTOUT)!($D(DUOUT)) G Q
|
|---|
| 6 | . N DIS,DIS0,DA,DC,DE,DJ,DL D S3^DIBT1 Q
|
|---|
| 7 | I X="" G G:'$D(DIAR)
|
|---|
| 8 | I Y<0 G Q:X=U,0
|
|---|
| 9 | I $D(DIARU),DIARU-Y=0 W $C(7),!,"Archivers must not store results in the default template" G 0
|
|---|
| 10 | S (DIARI,DISV)=+Y,A=$D(^DIBT(DISV,"DL")) S:$D(DIS0)#2 ^("DL")=DIS0 S:$D(DA)#2 ^("DA")=DA S:$D(DJ)#2 ^("DJ")=DJ
|
|---|
| 11 | I $D(DIAR),'$D(DIARU) S $P(^DIAR(1.11,DIARC,0),U,3)=DISV
|
|---|
| 12 | S Z=-1,DIS0="^DIBT(+Y," F P="DIS","DA","DC","DE","DJ","DL" S %Y=DIS0_""""_P_""",",%X=P_"(" D %XY^%RCR
|
|---|
| 13 | S %X="^UTILITY($J,",%Y="^DIBT(DISV,""O"",",@(%X_"0)=U") D %XY^%RCR
|
|---|
| 14 | G N DISTXT S %X="^UTILITY($J,",%Y="DISTXT(" D %XY^%RCR
|
|---|
| 15 | W ! S Y=DI D Q S DIC=Y G EN1^DIP:$D(SF)!$D(L)&'$D(DIAR),EN^DIP
|
|---|
| 16 | ;
|
|---|
| 17 | TEM ;
|
|---|
| 18 | K DIC S X=$P($E(X,2,99),"]",1),DIC="^DIBT(",DIC(0)="EQ",DIC("S")="I "_$S($D(DIAR):"$P(^(0),U,8)",1:"'$P(^(0),U,8)")_",$P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$D(^(""DIS""))"
|
|---|
| 19 | S DIC("W")="X ""F %=1:1 Q:'$D(^DIBT(Y,""""O"""",%,0)) W !?9 S I=^(0) W:$L(I)+$X>79 !?9 W I"""
|
|---|
| 20 | D ^DIC K DIC G F^DIS:Y<0
|
|---|
| 21 | S P="DIS",Z=-1,%X="^DIBT(+Y,P,",%Y="DIS(" D %XY^%RCR
|
|---|
| 22 | S %Y="^UTILITY($J,",P="O" D %XY^%RCR
|
|---|
| 23 | G DIS2
|
|---|
| 24 | ;
|
|---|
| 25 | COMP ;
|
|---|
| 26 | S E=X,DICMX="X DIS(DIXX)",DICOMP=N_"?",DQI="Y(",DA="DIS("""_$C(DC+64)_DL_"""," I $D(O(DC))[0 S O(DC)=X
|
|---|
| 27 | G COLON:X?.E1":"
|
|---|
| 28 | I X?.E1":.01",$D(O(DC))[0 S O(DC)=$E(X,1,$L(X)-4)
|
|---|
| 29 | D EN^DICOMP,XA G X:'$D(X),X:Y["m" ;I Y["m" S X=E_":" G COMP
|
|---|
| 30 | S DA(DC)=X,DU=-DC,E=$E("B",Y["B")_$E("D",Y["D") I Y["p" S E="p"_+$P(Y,"p",2)
|
|---|
| 31 | G G^DIS
|
|---|
| 32 | XA S %=0 F S %=$O(X(%)) Q:%="" S @(DA_%_")")=X(%)
|
|---|
| 33 | S %=-1 Q
|
|---|
| 34 | COLON D ^DICOMPW,XA G X:'$D(X)
|
|---|
| 35 | S R(DL)=R,N(DL)=N,N=+Y,DY=DY+1,DV(DL)=DV,DL(DL)=DK,DL=DL+1,DV=DV_-DY_C,DY(DY)=DP_U_$S(Y["m":DC_"."_DL,1:"")_U_X,R=U_$P(DP,U,2)
|
|---|
| 36 | K X G R^DIS
|
|---|
| 37 | ;
|
|---|
| 38 | Q ;
|
|---|
| 39 | K DIC,DA,DX,O,D,DC,DI,DK,DL,DQ,DU,DV,E,DE,DJ,N,P,Z,R,DY,DTOUT,DIRUT,DUOUT,DIROUT,^UTILITY($J)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | X K O(DC) G X^DIS
|
|---|
| 43 | ;
|
|---|
| 44 | DIS ;PUT SET LOGIC INTO DIS FOR SUBFILE
|
|---|
| 45 | S %X="" F %Y=1:1 S %X=$O(DIS(%X)) Q:'%X S %=$S($D(DIAR(DIARF,%X)):DIAR(DIARF,%X),1:DIS(%X)) S:%["X DIS(" %=$P(%,"X DIS(")_"X DIFG("_DIARF_","_$P(%,"X DIS(",2) S ^DIAR(1.11,DIARC,"S",%Y,0)=%X,^(1)=%
|
|---|
| 46 | S:%Y>1 %Y=%Y-1,^DIAR(1.11,DIARC,"S",0)="^1.1132^"_%Y_U_%Y G DIS2
|
|---|
