| [613] | 1 | DIQ1 ;SFISC/XAK-INQUIRY WITH COMPUTED FIELDS ;6:09 AM 24 Nov 2003
|
|---|
| 2 | ;;22.0;VA FileMan;**19,64,76,133**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | A S DIDQ=DD S:'$D(DICMX) DICMX="W !,O,"": "",X"
|
|---|
| 6 | N W,DD,D,Z
|
|---|
| 7 | F W=0:0 S W=$O(^DD(DIDQ,W)) Q:W'>0 I $D(^(W,0))#2 S Z=^(0),C=$P(Z,U,2),O=$P(Z,U)_" (c)" I C["C" X $P(Z,U,5,99) I X]"" D Q:'S
|
|---|
| 8 | .N Y S Y=X
|
|---|
| 9 | .I C["p",Y S Y=$$CP(C,Y)
|
|---|
| 10 | .E I C["D" X ^DD("DD")
|
|---|
| 11 | .D W2^DIQ
|
|---|
| 12 | K DIDQ,DICMX Q
|
|---|
| 13 | ;
|
|---|
| 14 | CP(C,X) ;
|
|---|
| 15 | S:C["p" C=+$P(C,"p",2) I C,$D(^DIC(C,0,"GL")),$D(@(^("GL")_"0)")),$D(^(X,0)) S X=$$EXTERNAL^DIDU(C,.01,"",$P(^(0),U))
|
|---|
| 16 | Q X
|
|---|
| 17 | ;
|
|---|
| 18 | EN ;
|
|---|
| 19 | Q:'$D(DIC)!($D(DA)[0)!($D(DR)[0) S DIL=0,(DA(0),D0)=DA,DIQ0=""
|
|---|
| 20 | I $D(DIQ)#2 G Q:DIQ["^"!($E(DIQ,1,2)="DI") S:DIQ'["(" DIQ=DIQ_"("
|
|---|
| 21 | S:'$D(DIQ(0)) DIQ(0)="",DIQ0="DIQ(0),"
|
|---|
| 22 | I $D(DIQ)[0 S DIQ="^UTILITY(""DIQ1"",$J,",DIQ0="DIQ,"
|
|---|
| 23 | S DIQ0=DIQ0_"DIQ0"
|
|---|
| 24 | I DIC S DIC=$S($D(^DIC(DIC,0,"GL")):^("GL"),1:"") G:DIC="" Q
|
|---|
| 25 | L G Q:'$D(@(DIC_"0)")) S DI=+$P(^(0),U,2) G Q:'$D(^(DA,0))
|
|---|
| 26 | N DII F DII=1:1 S DIQ1=$P(DR,";",DII) Q:DIQ1="" D C:DIQ1[":",F:DIQ1>0
|
|---|
| 27 | Q Q:DIL K %,I,J,X,Y,C,DA(0),DRS,DIL,DI,DIQ1 K:DIQ0]"" @DIQ0 K:$D(DIQ0) DIQ0
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | C S DIQ2=$P(DIQ1,":",2)
|
|---|
| 31 | F DIQ1=DIQ1:0 D F S DIQ1=$O(^DD(DI,DIQ1)) I DIQ1'>0!(DIQ1'<DIQ2) S:DIQ1'=DIQ2 DIQ1=0 Q
|
|---|
| 32 | Q
|
|---|
| 33 | F Q:'$D(^DD(DI,DIQ1,0))
|
|---|
| 34 | S Y=^(0),C=$P(Y,U,4),X=$P(C,";",2),C=$P(C,";"),J=$P(Y,U,2) G P:J["C"
|
|---|
| 35 | I +C'=C S C=""""_C_""""
|
|---|
| 36 | I X=0,$D(^DD(+J,.01,0)) G WD:$P(^(0),U,2)["W",S
|
|---|
| 37 | S C=$G(@(DIC_DA_","_C_")")),Y=$S(X["E":$E(C,+$P(X,"E",2),+$P(X,",",2)),1:$P(C,U,X))
|
|---|
| 38 | I DIQ(0)["I",(DIQ(0)["N"&(Y]"")!(DIQ(0)'["N")) S @(DIQ_"DI,DA,DIQ1,""I"")")=Y
|
|---|
| 39 | P Q:DIQ(0)'["E"&(DIQ(0)["I")
|
|---|
| 40 | I J["C" X $P(Y,U,5,999) K Y S Y=X D:J["D" D^DIQ
|
|---|
| 41 | I J'["C" S C=$P(^DD(DI,DIQ1,0),U,2) D:Y]"" Y^DIQ
|
|---|
| 42 | Q:Y=""&(DIQ(0)["N")
|
|---|
| 43 | S @(DIQ_"DI,DA,DIQ1"_$S(DIQ(0)'["E":"",1:",""E""")_")")=Y
|
|---|
| 44 | Q
|
|---|
| 45 | WD F X=0:0 S X=$O(@(DIC_"DA,"_C_",X)")) Q:X'>0 S @(DIQ_"DI,DA,DIQ1,X)")=^(X,0)
|
|---|
| 46 | Q
|
|---|
| 47 | S ;
|
|---|
| 48 | Q:'$D(DR(+J)) Q:'$D(DA(+J)) N DIQ1,I,DI S DIL=DIL+1
|
|---|
| 49 | S DRS(DIL)=DR,DIC(DIL)=DIC,DR=DR(+J),DA(DIL)=DA
|
|---|
| 50 | S DI=+J,DIC=DIC_DA_","_C_",",DA=DA(+J),@("D"_DIL)=DA
|
|---|
| 51 | D L S DR=DRS(DIL),DA=DA(DIL),DIC=DIC(DIL)
|
|---|
| 52 | K DRS(DIL),DIC(DIL),DA(DIL),@("D"_DIL)
|
|---|
| 53 | S DIL=DIL-1 Q
|
|---|
