File:  [Coherent Logic Development] / freem_fileman / USER / DIFROM42.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIFROM42	;SFISC/XAK-CREATES 'INIT4' ;10:55 AM  11 Feb 1993
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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 S %=""
   26: 	;; S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1  S %=+Y Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>