| 1 | DIE3 ;SFISC/XAK-PROCESS SINGLE-VALUED VARIABLE PNTR ;5:50 AM 13 Feb 2003
|
|---|
| 2 | ;;22.0;VA FileMan;**4,123**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | V ;
|
|---|
| 5 | S DIEX=X ;I $D(DNM) S DIDS=D
|
|---|
| 6 | G ALL:X'["." S DIVP=$P(X,"."),X=$P(X,".",2,999),Y=-1,A9=1 I X="" G Q
|
|---|
| 7 | I DIVP]"",$D(^DD(DP,DIFLD,"V","P",DIVP)) D FND G Q
|
|---|
| 8 | I DIVP="" G ALL
|
|---|
| 9 | S X="" F %=0:0 S X=$O(^DD(DP,DIFLD,"V","M",X)) Q:X="" I $P(X,DIVP)="" S DIVP=X,X=$P(DIEX,".",2,999) D FND G Q:Y>0 S X=$P(DIEX,".")
|
|---|
| 10 | F DIVP=0:0 S DIVP=$O(^DD(DP,DIFLD,"V",DIVP)) Q:+DIVP'>0 I $D(^(DIVP,0)) S DIVPDIC=^(0) I $D(^DIC(+DIVPDIC,0)) S %=$P(^(0),U) I $P(%,$P(DIEX,"."))="" S X=$P(DIEX,".",2,999) D DIC G Q:Y>0 S X=$P(DIEX,".")
|
|---|
| 11 | I A9 S X=DIEX,A9=0 G ALL
|
|---|
| 12 | G Q
|
|---|
| 13 | ;
|
|---|
| 14 | ALL F DIVP1=0:0 S DIVP1=$O(^DD(DP,DIFLD,"V","O",DIVP1)) Q:+DIVP1'>0 S DIVP=DIVP1 D FND Q:Y>0 S X=DIEX
|
|---|
| 15 | G Q
|
|---|
| 16 | ;
|
|---|
| 17 | FND S DIVP=+$O(^(DIVP,0)) I $D(^DD(DP,DIFLD,"V",DIVP,0)) S DIVPDIC=^(0) D DIC
|
|---|
| 18 | I Y>0 S A9=0
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | DIC I '$D(^DIC(+DIVPDIC,0,"GL")) S Y=-1 Q
|
|---|
| 22 | I $D(DIC("V")) S Y=DIVP,Y(0)=DIVPDIC X DIC("V") I '$T K Y S Y=-1 Q
|
|---|
| 23 | N DIVPSEL S DIVPSEL(0)=0
|
|---|
| 24 | I $D(DIVP1),'$D(DB(DQ)),'$G(DIQUIET) D H1 W:'$D(DDS) !
|
|---|
| 25 | S DIC=^DIC(+DIVPDIC,0,"GL"),DIC(0)="MD"_$E("E",'$D(DB(DQ))&'$D(DIR("V")))_$E("L",$P(DIVPDIC,U,6)="y")_$E("Z",$D(DDS)) I $P(DIVPDIC,U,5)="y",$D(^DD(DP,DIFLD,"V",DIVP,1)),^(1)]"" X ^(1)
|
|---|
| 26 | I $D(DIR)=10,'$D(DDS) S DIC(0)=$P(DIC(0),"L")_$P(DIC(0),"L",2)
|
|---|
| 27 | D PTRIX S X=+Y_";"_$E(DIC,2,99) K:Y<0 X S %=1
|
|---|
| 28 | I Y>0,'DIVPSEL(0),'$D(DB(DQ)),'$P(Y,U,3),'$$CHKO,'$G(DIQUIET) D S1 ; 22*123
|
|---|
| 29 | D Q
|
|---|
| 30 | .N DICV
|
|---|
| 31 | .I $D(DIC("V")) S DICV=DIC("V")
|
|---|
| 32 | .K DIC S DIC=DIE S:$D(DICV) DIC("V")=DICV
|
|---|
| 33 | .Q
|
|---|
| 34 | ;
|
|---|
| 35 | S1 S A1="Q",DST=%_U_" ...OK" D S S:%'=1 Y=-1 Q
|
|---|
| 36 | ;
|
|---|
| 37 | H S DDH=$S($D(DDH):DDH+1,1:1),DDH(DDH,A1)=DST K DST Q
|
|---|
| 38 | ;
|
|---|
| 39 | H1 ;also called by DICM3
|
|---|
| 40 | W:'$D(DDS) !
|
|---|
| 41 | S A1="T",DST=$$EZBLD^DIALOG(8070,$P(DIVPDIC,U,2))
|
|---|
| 42 | S I $D(DDS) D H S DDD=1 D ^DDSU K DDD G QS
|
|---|
| 43 | I A1["T" W !,DST G QS
|
|---|
| 44 | I A1["Q" S %=+$P(DST,U,1) W !,$P(DST,U,2) D YN^DICN G QS
|
|---|
| 45 | I A1["X" X DST
|
|---|
| 46 | QS K A1,DST Q
|
|---|
| 47 | ;
|
|---|
| 48 | Q K A1,DIVP1,DIVP,DIVPDIC,A9
|
|---|
| 49 | I $D(DNM) G:Y>0 @("V^"_DNM) S X=DIEX K DIEX G X^DIE17:'$D(DB(DQ)),B^DIE17
|
|---|
| 50 | K DIEX Q:$D(DIR) G V^DIED:Y>0,X^DIED:'$D(DB(DQ)),B^DIE1
|
|---|
| 51 | ;
|
|---|
| 52 | PTRIX ;Check for DIC("PTRIX"); do appropriate ^DIC call
|
|---|
| 53 | K DIC("PTRIX"),D
|
|---|
| 54 | M DIC("PTRIX")=DIE("PTRIX")
|
|---|
| 55 | ;
|
|---|
| 56 | S D=$G(DIE("PTRIX",DP,DIFLD,+DIVPDIC))
|
|---|
| 57 | I $P(DIVPDIC,U,6)="y",(U_D_U)'["^B^" S D=D_"^B"
|
|---|
| 58 | ;
|
|---|
| 59 | I $G(D)]"",$P(D,U,2)="" S DIC(0)=$TR(DIC(0),"M")
|
|---|
| 60 | E S:DIC(0)'["M" DIC(0)="M"_DIC(0)
|
|---|
| 61 | ;
|
|---|
| 62 | I $P($G(D),U)="" D
|
|---|
| 63 | . K D D ^DIC
|
|---|
| 64 | E I $P(D,U,2)]"" D
|
|---|
| 65 | . D MIX^DIC1
|
|---|
| 66 | E D IX^DIC
|
|---|
| 67 | K DIC("PTRIX")
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | CHKO() ; New with 22*123. Check for 'O' (Ask 'OK')
|
|---|
| 71 | ; Backwards compatibility check
|
|---|
| 72 | I $P(^DIC(+DIVPDIC,0),U,2)["O" Q 1
|
|---|
| 73 | ; If $P#2 of the File Header ["O" then Quit True
|
|---|
| 74 | Q $P(@(^DIC(+DIVPDIC,0,"GL")_"0)"),U,2)["O"
|
|---|
| 75 | ;#8070 Searching for a |filename|
|
|---|
