File:  [Coherent Logic Development] / freem_fileman / USER / DIFROM4.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: DIFROM4	;SFISC/XAK-CREATES 'INIT3' ;10:40 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_3,DIRS=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) S:$E(X,4,5)="OR" ^(0)=^(0)_DIRS
    6: 	D ^DIFROM41
    7: 	S DIFROM=2 D ZI^DIFROM3 G ^DIFROM42
    8: TXT	;
    9: 	;; K ^UTILITY("DIFROM",$J) S DIC(0)="LX",(DIC,DLAYGO)=3.6,N="BUL" D ADD:$D(^XMB(3.6,0))
   10: 	;; S X=0 F R=0:0 S X=$O(^UTILITY("DIFROM",$J,N,X)) Q:X=""  W !,"'",X,"' BULLETIN FILED -- Remember to add mail groups for new bulletins."
   11: 	;; I $D(^DIC(9.4,0))#2,^(0)?1"PACK".E S N="PKG",(DIC,DLAYGO)=9.4 D ADD
   12: 	;; G NP:'$D(DA) S %=+$O(^DIC(9.4,DA,22,"B",DIFROM,0)) I $D(^DIC(9.4,DA,22,%,0)) S $P(^(0),U,3)=DT
   13: 	;; I $D(^DIC(9.4,DA,0))#2 S %=$P(^(0),U,4) I %]"" S %=$O(^DIC(9.2,"B",%,0)) S:%]"" $P(^DIC(9.4,DA,0),U,4)=%
   14: 	;;OR I $D(^ORD(100.99))&$O(^UTILITY(U,$J,"OR","")) D EN^
   15: 	;;NP K DIC,^UTILITY("DIFROM",$J) S DIC(0)="LX" I $D(^DIC(19,0))#2,^(0)?1"OPTION".E S (DIC,DLAYGO)=19,N="OPT" D ADD,OP
   16: 	;; I $D(^DIC(19.1,0))#2,($P(^(0),U)?1"SECUR".E)!($P(^(0),U)="KEY") S (DIC,DLAYGO)=19.1,N="KEY" D ADD K ^UTILITY("DIFROM",$J)
   17: 	;; I $D(^DIC(9.8,0))#2,^(0)?1"ROUTINE^".E S (DIC,DLAYGO)=9.8,N="RTN" D ADD
   18: 	;; S DIC=.5,DLAYGO=0,N="FUN" D ADD
   19: 	;; S DIC("S")="I $P(^(0),U,4)=DIFL" F N="DIPT","DIBT","DIE" S DIC=U_N_"(" D ADD
   20: 	;; K DIC("S") S N="DIST(.404,",DIC=U_N,DLAYGO=.404 D ADD
   21: 	;; S DIC("S")="I $P(^(0),U,8)=DIFL",N="DIST(.403,",DIC=U_N,DLAYGO=.403 D ADD
   22: 	;; K ^UTILITY(U,$J),DIC,DLAYGO F DIFR="DIE","DIPT" D DIEZ
   23: 	;; K ^UTILITY("DIFROM",$J) Q

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