- DIFROM42 ;SFISC/XAK-CREATES 'INIT4' ;10/9/95 05:59
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- S DNAME=E_4,DL=0,(DH,Q)=" ;"
- K ^UTILITY($J) F DD=1:1 S X=$T(TXT+DD) Q:X="" S ^UTILITY($J,DD,0)=$E(X,4,999)
- S DIFROM=2 D ZI^DIFROM3 G ^DIFROM5
- TXT ;
- ;;EN S DA(1)=1,DIK="^ORD(100.99,1,5," I $D(^ORD(100.99,1,5,DA)) D ^DIK
- ;; S %X="^UTILITY(U,$J,""OR"","_$O(^UTILITY(U,$J,"OR",""))_",",%Y=DIK_DA_","
- ;; S:'$D(^ORD(100.99,1,5,0)) ^(0)="^100.995P^^" S $P(^(0),U,3,4)=DA_U_($P(^(0),U,4)+1)
- ;; D %XY^%RCR S $P(^ORD(100.99,1,5,DA,0),U)=DA,%=$P(^(0),U,4)
- ;; I %]"" S %=$O(^ORD(100.98,"B",%,0)) I %>0 S $P(^ORD(100.99,1,5,DA,0),U,4)=%
- ;; D OR
- ;; S DA(1)=1 D IX1^DIK
- ;; Q
- ;;OR S (N,I)=0,X=""
- ;; 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
- ;; S:I $P(^ORD(100.99,1,5,DA,1,0),U,3,4)=X_U_I S (N,I)=0,X=""
- ;; 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
- ;; S:I $P(^ORD(100.99,1,5,DA,5,0),U,3,4)=X_U_I K N,R,X,Y,I,J
- ;; Q
- ;;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
- ;; S:J $P(^ORD(100.99,1,5,DA,1,N,1,0),U,3,4)=Y_U_J
- ;; Q
- ;;ADDP N I,J,N,R,DA,DLAYGO,DO S %=""
- ;; S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1 S %=+Y Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROM42 1777 printed Feb 19, 2025@00:14:21 Page 2
- DIFROM42 ;SFISC/XAK-CREATES 'INIT4' ;10/9/95 05:59
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- +7 SET DNAME=E_4
- SET DL=0
- SET (DH,Q)=" ;"
- +8 KILL ^UTILITY($JOB)
- FOR DD=1:1
- SET X=$TEXT(TXT+DD)
- if X=""
- QUIT
- SET ^UTILITY($JOB,DD,0)=$EXTRACT(X,4,999)
- +9 SET DIFROM=2
- DO ZI^DIFROM3
- GOTO ^DIFROM5
- TXT ;
- +1 ;;EN S DA(1)=1,DIK="^ORD(100.99,1,5," I $D(^ORD(100.99,1,5,DA)) D ^DIK
- +2 ;; S %X="^UTILITY(U,$J,""OR"","_$O(^UTILITY(U,$J,"OR",""))_",",%Y=DIK_DA_","
- +3 ;; S:'$D(^ORD(100.99,1,5,0)) ^(0)="^100.995P^^" S $P(^(0),U,3,4)=DA_U_($P(^(0),U,4)+1)
- +4 ;; D %XY^%RCR S $P(^ORD(100.99,1,5,DA,0),U)=DA,%=$P(^(0),U,4)
- +5 ;; I %]"" S %=$O(^ORD(100.98,"B",%,0)) I %>0 S $P(^ORD(100.99,1,5,DA,0),U,4)=%
- +6 ;; D OR
- +7 ;; S DA(1)=1 D IX1^DIK
- +8 ;; Q
- +9 ;;OR S (N,I)=0,X=""
- +10 ;; 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
- +11 ;; S:I $P(^ORD(100.99,1,5,DA,1,0),U,3,4)=X_U_I S (N,I)=0,X=""
- +12 ;; 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
- +13 ;; S:I $P(^ORD(100.99,1,5,DA,5,0),U,3,4)=X_U_I K N,R,X,Y,I,J
- +14 ;; Q
- +15 ;;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
- +16 ;; S:J $P(^ORD(100.99,1,5,DA,1,N,1,0),U,3,4)=Y_U_J
- +17 ;; Q
- +18 ;;ADDP N I,J,N,R,DA,DLAYGO,DO S %=""
- +19 ;; S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1 S %=+Y Q
