| 1 | DIFROM42 ;SFISC/XAK-CREATES 'INIT4' ;10/9/95 05:59
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S DNAME=E_4,DL=0,(DH,Q)=" ;"
|
|---|
| 5 | K ^UTILITY($J) F DD=1:1 S X=$T(TXT+DD) Q:X="" S ^UTILITY($J,DD,0)=$E(X,4,999)
|
|---|
| 6 | S DIFROM=2 D ZI^DIFROM3 G ^DIFROM5
|
|---|
| 7 | TXT ;
|
|---|
| 8 | ;;EN S DA(1)=1,DIK="^ORD(100.99,1,5," I $D(^ORD(100.99,1,5,DA)) D ^DIK
|
|---|
| 9 | ;; S %X="^UTILITY(U,$J,""OR"","_$O(^UTILITY(U,$J,"OR",""))_",",%Y=DIK_DA_","
|
|---|
| 10 | ;; S:'$D(^ORD(100.99,1,5,0)) ^(0)="^100.995P^^" S $P(^(0),U,3,4)=DA_U_($P(^(0),U,4)+1)
|
|---|
| 11 | ;; D %XY^%RCR S $P(^ORD(100.99,1,5,DA,0),U)=DA,%=$P(^(0),U,4)
|
|---|
| 12 | ;; I %]"" S %=$O(^ORD(100.98,"B",%,0)) I %>0 S $P(^ORD(100.99,1,5,DA,0),U,4)=%
|
|---|
| 13 | ;; D OR
|
|---|
| 14 | ;; S DA(1)=1 D IX1^DIK
|
|---|
| 15 | ;; Q
|
|---|
| 16 | ;;OR S (N,I)=0,X=""
|
|---|
| 17 | ;; F S N=$O(^ORD(100.99,1,5,DA,1,N)) Q:'N S X=$P(^(N,0),U) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% ^ORD(100.99,1,5,DA,1,N,0)=% S X=N,I=I+1,(R,J)=0,Y="" D OR1
|
|---|
| 18 | ;; S:I $P(^ORD(100.99,1,5,DA,1,0),U,3,4)=X_U_I S (N,I)=0,X=""
|
|---|
| 19 | ;; F S N=$O(^ORD(100.99,1,5,DA,5,N)) Q:'N S X=$P(^(N,0),U,3) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% $P(^ORD(100.99,1,5,DA,5,N,0),U,3)=% S X=N,I=I+1
|
|---|
| 20 | ;; S:I $P(^ORD(100.99,1,5,DA,5,0),U,3,4)=X_U_I K N,R,X,Y,I,J
|
|---|
| 21 | ;; Q
|
|---|
| 22 | ;;OR1 N X F S R=$O(^ORD(100.99,1,5,DA,1,N,1,R)) Q:'R S X=$P(^(R,0),U) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% ^ORD(100.99,1,5,DA,1,N,1,R,0)=% S Y=R,J=J+1
|
|---|
| 23 | ;; S:J $P(^ORD(100.99,1,5,DA,1,N,1,0),U,3,4)=Y_U_J
|
|---|
| 24 | ;; Q
|
|---|
| 25 | ;;ADDP N I,J,N,R,DA,DLAYGO,DO S %=""
|
|---|
| 26 | ;; S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1 S %=+Y Q
|
|---|
