| 1 | DIE1 ;SFISC/GFT-FILE DATA, XREF IT, GO UP AND DOWN MULTIPLES ;28MAY2008
|
|---|
| 2 | ;;22.0;VA FileMan;**1,4,11,159**;Mar 30, 1999;Build 8
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | K DQ,DB G E1:$D(DG)<9 I DP<0 K DG S DQ=0 Q
|
|---|
| 5 | S DQ="",DU=-2,DG="$D("_DIE_DA_",DU))"
|
|---|
| 6 | Y S DQ=$O(DG(DQ)),DW=$P(DQ,";",2) G DE:$P(DQ,";")=DU
|
|---|
| 7 | I DU'<0 S ^(DU)=DV,DU=-2
|
|---|
| 8 | G IX:DQ="" S DU=$P(DQ,";",1),DV="" I @DG S DV=^(DU)
|
|---|
| 9 | DE I 'DW S DW=$E(DW,2,99),DE=DW-$L(DV)-1,%=$P(DW,",",2)+1,X=$E(DV,%,999),DV=$E(DV,0,DW-1)_$J("",$S(DE>0:DE,1:0))_DG(DQ) S:X'?." " DV=DV_$J("",%-DW-$L(DG(DQ)))_X G Y
|
|---|
| 10 | PC S $P(DV,"^",DW)=DG(DQ) G Y
|
|---|
| 11 | ;
|
|---|
| 12 | IX S DICRREC="LOADXR^DIED",DQ=$O(DE(" ")) G E1:DQ="",E1:'$D(DG(DQ)) I $D(DE(DE(DQ)))#2 F DG=1:1 Q:'$D(DE(DQ,DG)) S DIC=DIE,X=DE(DE(DQ)) X DE(DQ,DG,2)
|
|---|
| 13 | S X="" I DG(DQ)]"" F DG=1:1 Q:'$D(DE(DQ,DG)) S DIC=DIE,X=DG(DQ) X DE(DQ,DG,1)
|
|---|
| 14 | D:$D(DIEFXREF) FIREFLD
|
|---|
| 15 | E1 K DICRREC,DIFLD,DG,DB,DE,DIANUM S DQ=0 Q
|
|---|
| 16 | ;
|
|---|
| 17 | B ;
|
|---|
| 18 | I '$D(DB(DQ)) S X="?BAD" G ^DIEQ
|
|---|
| 19 | S DC=DQ,DIK="",DL=1
|
|---|
| 20 | OUT ;
|
|---|
| 21 | D DIE1 S Y(DC)=DIK G UP:DL>1,Q:DC=0,QY
|
|---|
| 22 | ;
|
|---|
| 23 | E ;
|
|---|
| 24 | I DP'<0 S DC=$S($D(X)#2:X,1:"") D DIE1 S X=DC G G:DI>0,UP:DL>1
|
|---|
| 25 | Q K Y
|
|---|
| 26 | QY I $D(DTOUT),$D(DIEDA) D
|
|---|
| 27 | . N % K DA
|
|---|
| 28 | . F %=1:1 Q:'$D(DIEDA(%)) S DA(%)=DIEDA(%)
|
|---|
| 29 | . S DA=DIEDA
|
|---|
| 30 | . Q
|
|---|
| 31 | K:$D(DTOUT) DG,DQ
|
|---|
| 32 | I $D(DIETMP)#2 D FIREREC K @DIETMP,DIETMP
|
|---|
| 33 | K DIEBADK,DIEFIRE,DIEXREF,DIEFXREF,DIIENS,DIE1,DIESP
|
|---|
| 34 | K DIP,DB,DE,DM,DK,DL,DH,DU,DV,DW,DP,DC,DIK,DOV,DIEL,DIFLD Q
|
|---|
| 35 | ;
|
|---|
| 36 | M ;
|
|---|
| 37 | S DD=X,DIC(0)="LM"_$S($D(DB(DQ)):"X",1:"QE"),DO(2)=$P(DC,"^",2),DO=$P($P(DQ(DQ),U)," ",2,99)_"^"_DO(2)_"^"_$P(DC,"^",4,5) D DOWN I @("'$D("_DIC_"0))") S ^(0)="^"_DO(2)
|
|---|
| 38 | E I DO(2)["I" S %=0,DIC("W")="" D W^DIC1
|
|---|
| 39 | K DIC("PTRIX") M DIC("PTRIX")=DIE("PTRIX")
|
|---|
| 40 | DIC S D="B",DLAYGO=DP\1,X=DD D K DIC("PTRIX")
|
|---|
| 41 | .N DIETMP,DICR D X^DIC
|
|---|
| 42 | I Y>0 S DA=+Y,DI=0,X=$P(Y,U,2) S:$D(DIETMP)#2 $P(DIIENS,",")=DA S:+DR=.01!(DR="")&$P(Y,U,3) DI=.01,DK=1,DM=$P($P(DR,";",1),":",2),DM=$S(DR="":9999999,DM="":+DR,1:DM) G D1
|
|---|
| 43 | S DI(DL-1)=DI(DL-1)_U K DUOUT,DTOUT G U1
|
|---|
| 44 | ;
|
|---|
| 45 | DOWN D S,DIE1,DDA S DIE=DIC Q
|
|---|
| 46 | ;
|
|---|
| 47 | S ;CALLED BY O+1^DIE0
|
|---|
| 48 | S DIOV(DL)=$G(DOV,0) K DOV
|
|---|
| 49 | S DIE1N(DL)=$G(DIE1N),DP(DL)=DP,DP=+$P(DC,"^",2),DI(DL)=$S(DV'["M":DI,$D(DSC(DP))!$D(DB(DQ)):DI,1:DI_U_$G(DQ(DQ,"CAPTION"))),DIE(DL)=DIE,DK(DL)=DK,DR(DL)=DR
|
|---|
| 50 | S DM(DL)=DM,DK=0,DIE1(DL)=DIE1,DL=DL+1,DIE1=$S($G(DIE1N):DIE1N,1:DL),DIEL=DIEL+1,DM=9999999,DR=""
|
|---|
| 51 | I $D(DR(DIE1,DP)) S DM=0,DR=DR(DIE1,DP)
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | DDA N T,X
|
|---|
| 55 | S T=$T
|
|---|
| 56 | F X=+$O(DA(" "),-1):-1:1 K DA(X+1) S:$D(DA(X))#2 DA(X+1)=DA(X)
|
|---|
| 57 | K DA(1) S:$D(DA)#2 DA(1)=DA
|
|---|
| 58 | S DIC=DIE_DA_","""_$P(DC,U,3)_""","
|
|---|
| 59 | S:$D(DIETMP)#2 DIIENS=","_DIIENS
|
|---|
| 60 | I T
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | UDA N T,X
|
|---|
| 64 | S T=$T
|
|---|
| 65 | S DA=$G(DA(1)) ;K DA(1)
|
|---|
| 66 | F X=2:1:+$O(DA(" "),-1) I $D(DA(X))#2 S DA(X-1)=DA(X) K DA(X)
|
|---|
| 67 | S:$D(DIETMP)#2 DIIENS=$P(DIIENS,",",2,999)
|
|---|
| 68 | I T
|
|---|
| 69 | Q
|
|---|
| 70 | N ;
|
|---|
| 71 | D DOWN S DA=$P(DC,U,4),DI=.01 S:$D(DIETMP)#2 $P(DIIENS,",")=DA S ^DISV(DUZ,$E(DIC,1,28))=$E(DIC,29,999)_DA
|
|---|
| 72 | D1 S @("D"_DIEL)=DA
|
|---|
| 73 | G G MORE^DIE
|
|---|
| 74 | ;
|
|---|
| 75 | UP ;
|
|---|
| 76 | Q:$D(DTOUT)
|
|---|
| 77 | S DP(0)=DP_U_DK(DL-1) I $D(DIEC(DL)) D DIEC G U
|
|---|
| 78 | U1 D UDA S DIEL=DIEL-1
|
|---|
| 79 | U S DQ=0,DL=DL-1,DIE1N=DIE1N(DL),DIE=DIE(DL),DM=DM(DL),DI=DI(DL),DP=DP(DL),DR=DR(DL),DK=DK(DL),DIE1=DIE1(DL) I $D(DIOV(DL)) S DOV=DIOV(DL) K DIOV(DL)
|
|---|
| 80 | G G
|
|---|
| 81 | ;
|
|---|
| 82 | DIEC K DA S DA=DIEC(DL) F %=1:1 Q:'$D(DIEC(DL,%)) S DA(%)=DIEC(DL,%)
|
|---|
| 83 | F DIEL=0:1 Q:'$D(DIEC(DL,0,DIEL)) S @("D"_DIEL)=DIEC(DL,0,DIEL)
|
|---|
| 84 | S:$D(DIETMP)#2 DIIENS=DIEC(DL,"IENS")
|
|---|
| 85 | S DIEL=DIEL-1 K DIEC(DL)
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | FIREFLD ;Fire field-level xrefs stored in DIEFXREF
|
|---|
| 89 | D:$D(DIEFXREF)>2 FIRE^DIKC(DP,.DA,"KS","DIEFXREF","O","",$E("C",$G(DIOPER)="A"))
|
|---|
| 90 | K DIEFXREF
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | FIREREC ;Fire record-level xrefs accumulated in ^TMP
|
|---|
| 94 | Q:$D(DIETMP)[0 Q:$D(@DIETMP@("R"))<2
|
|---|
| 95 | N DP,DIIENS,DIE,DA,DIKEY,Y
|
|---|
| 96 | ;
|
|---|
| 97 | S DP=0 F S DP=$O(@DIETMP@("R",DP)) Q:'DP D
|
|---|
| 98 | . S DIIENS=" " F S DIIENS=$O(@DIETMP@("R",DP,DIIENS)) Q:DIIENS="" D
|
|---|
| 99 | .. D DA^DILF(DIIENS,.DA)
|
|---|
| 100 | .. D FIRE^DIKC(DP,.DA,"KS",$NA(@DIETMP@("R")),"F^^K",.DIKEY,$E("C",$G(DIOPER)="A"))
|
|---|
| 101 | ;
|
|---|
| 102 | ;If any keys are invalid, restore values
|
|---|
| 103 | D:$D(DIKEY)>9 RESTORE(.DIKEY,DIETMP)
|
|---|
| 104 | ;
|
|---|
| 105 | K DIEFIRE,@DIETMP@("R"),@DIETMP@("V")
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
| 108 | RESTORE(DIKEY,DIETMP) ;Restore key fields to their pre-edited values
|
|---|
| 109 | N DA
|
|---|
| 110 | K DIEBADK
|
|---|
| 111 | S:$D(DIEFIRE)#2 X="BADKEY"
|
|---|
| 112 | ;
|
|---|
| 113 | ;Set "write" and "restore" flags
|
|---|
| 114 | N DIEWR,DIEREST
|
|---|
| 115 | I '$D(ZTQUEUED),'$D(DDS),$D(DIEFIRE)[0!($G(DIEFIRE)["M") S DIEWR=1
|
|---|
| 116 | E S DIEWR=0
|
|---|
| 117 | I $D(DIEFIRE)#2,DIEFIRE'["R" S DIEREST=0
|
|---|
| 118 | E S DIEREST=1
|
|---|
| 119 | I '$G(DIEWR),'$G(DIEREST),$G(DIEFIRE)'["L" Q
|
|---|
| 120 | ;
|
|---|
| 121 | N DIEFDA,DIEKK,DIEMSG,DIFIL,DIFLD,DIFLDI,DIIENS,DIIENSA
|
|---|
| 122 | N DINEW,DIOLD,DIRFIL,X
|
|---|
| 123 | ;
|
|---|
| 124 | ;Loop through all keys that are not unique and build FDA
|
|---|
| 125 | K DIEFDA
|
|---|
| 126 | S DIRFIL=0 F S DIRFIL=$O(DIKEY(DIRFIL)) Q:'DIRFIL D
|
|---|
| 127 | . S DIEKK=0 F S DIEKK=$O(DIKEY(DIRFIL,DIEKK)) Q:'DIEKK D
|
|---|
| 128 | .. Q:$D(^DD("KEY",DIEKK,0))[0
|
|---|
| 129 | .. K DIFLD
|
|---|
| 130 | .. S DIFLDI=0 F S DIFLDI=$O(^DD("KEY",DIEKK,2,DIFLDI)) Q:'DIFLDI D
|
|---|
| 131 | ... S DIFLD=$P($G(^DD("KEY",DIEKK,2,DIFLDI,0)),U),DIFIL=$P($G(^(0)),U,2)
|
|---|
| 132 | ... Q:'DIFLD!'DIFIL
|
|---|
| 133 | ... S DIFLD(DIFIL,DIFLD)=$$FLEVDIFF^DIKCU(DIRFIL,DIFIL)
|
|---|
| 134 | .. S DIIENS=" " S DIIENS=$O(DIKEY(DIRFIL,DIEKK,DIIENS)) Q:DIIENS="" D
|
|---|
| 135 | ... S DIFIL=0 F S DIFIL=$O(DIFLD(DIFIL)) Q:'DIFIL D
|
|---|
| 136 | .... S DIFLD=0 F S DIFLD=$O(DIFLD(DIFIL,DIFLD)) Q:'DIFLD D
|
|---|
| 137 | ..... Q:$D(^DD(DIFIL,DIFLD,0))[0
|
|---|
| 138 | ..... S DIIENSA=$P(DIIENS,",",DIFLD(DIFIL,DIFLD)+1,999)
|
|---|
| 139 | ..... Q:$D(@DIETMP@("V",DIFIL,DIIENSA,DIFLD,"F"))[0!$D(^("4/")) S DIOLD=^("F")
|
|---|
| 140 | ..... K DA D DA^DILF(DIIENSA,.DA)
|
|---|
| 141 | ..... S X=$$DEC^DIKC2(DIFIL,DIFLD) Q:X="" X X S DINEW=X
|
|---|
| 142 | ..... I DIEREST S DIEFDA(DIFIL,DIIENSA,DIFLD)=DIOLD
|
|---|
| 143 | ..... I DIEWR!($G(DIEFIRE)["L") D
|
|---|
| 144 | ...... S DIEBADK(DIRFIL,DIEKK,DIFIL,DIIENSA,DIFLD,"O")=DIOLD
|
|---|
| 145 | ...... S DIEBADK(DIRFIL,DIEKK,DIFIL,DIIENSA,DIFLD,"N")=DINEW
|
|---|
| 146 | ;
|
|---|
| 147 | I DIEREST,$D(DIEFDA) D FILE^DIE("U","DIEFDA","DIEMSG") K DIERR
|
|---|
| 148 | I DIEWR,$D(DIEBADK) D MSG^DIEKMSG(.DIEBADK,DIEREST)
|
|---|
| 149 | ;
|
|---|
| 150 | I $G(DIEFIRE)'["L" K DIEBADK
|
|---|
| 151 | Q
|
|---|
