Return to DIFROMS5.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIFROMS5	;SCISC/DCL-DIFROM SERVER PROCESS TEMPLATES OUT;08:07 AM  1 Dec 1994;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	Q
    5: 	;
    6: EDEOUT	;EXTENDED DATABASE ELEMENTS OUT
    7: 	N DIFRDSV,DIFRF,DIFRGBL,DIFRSEC,DIFRTRT
    8: 	I $G(DIFRIEN)>0 G EDE
    9: 	N DIFRIENX,DIFRIENZ
   10: 	S DIFRIENX=$O(@DIFRLST@(0)),DIFRIENZ=$D(@DIFRLST@(DIFRIENX,0))#2,DIFRIENX=0
   11: 	F  S DIFRIENX=$O(@DIFRLST@(DIFRIENX)) Q:DIFRIENX'>0  D
   12: 	.I DIFRIENZ S DIFRIEN=+@DIFRLST@(DIFRIENX,0) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
   13: 	.S DIFRIEN=+@DIFRLST@(DIFRIENX) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
   14: 	Q
   15: EDE	;
   16: 	;  DIFRTRT=FULL ROOT IN DIST ARRAY
   17: 	;  DIFRDSV=0TH NODE OF TEMPLATE
   18: 	;         :.401, .4, .402
   19: 	;         :TEMPL NAME^DATE CREATED^READ^FILENR^DUZ^WRITE^DATE LAST USED
   20: 	;         :.403
   21: 	;         :FORM NAME^READ^WRITE^DUZ^DATE CREATED^DATA LAST USED^^FILE^
   22: 	;         :.84
   23: 	;         :DIALOG NUMBER^TYPE^INTERNAL PARM^PACKAGE FILE (pointer)
   24: 	;  DIFRSEC=FILE SECURITY 1=EXPORT SECURITY,0=NO FILE SECURITY
   25: 	;  DIFRIEN=TEMPLATE'S INTERNAL ENTRY NUMBER
   26: 	;         :.5 (FUNCTIONS)
   27: 	S DIFRTRT=$NA(@DIFRTA@(DIFRFILE,DIFRIEN))
   28: 	S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1)
   29: 	; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   30: 	;
   31: 	; For stand alone FileMan only - KIDS will do the Merge
   32: 	; v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
   33: 	;
   34: 	I $G(DIFRSTNA) S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1) M @DIFRTRT=@DIFRGBL@(DIFRIEN)
   35: 	;
   36: 	; ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
   37: 	; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   38: 	I DIFRFILE=.5 Q  ;no processing necessary
   39: 	S DIFRDSV=$G(@DIFRTRT@(0)),DIFRF=$P(DIFRDSV,U,$S(DIFRFILE=.403:8,1:4))
   40: 	I DIFRDSV="" D  Q
   41: 	.N DIFRERR S DIFRERR(1)=DIFRFNAM,DIFRERR(2)=DIFRIEN
   42: 	.D BLD^DIALOG(9516,.DIFRERR)
   43: 	.Q
   44: 	I DIFRFILE=.84 G DIALOG
   45: 	S DIFRSEC=$TR($P($G(@DIFRFIA@(DIFRF,0,1)),U,2),"y","Y")="Y"
   46: 	I DIFRFILE=.403 G T403
   47: 	Q:'$D(@DIFRTRT@(0))  K ^("RD"),^("AB") K:DIFRFILE=.401 ^(1)
   48: 	S $P(@DIFRTRT@(0),U,5)="" S:'DIFRSEC ^(0)=$P(DIFRDSV,U,1,2)_U_U_DIFRF_U_U_U_U_$P(DIFRDSV,U,8)
   49: 	Q
   50: 	;
   51: T403	;PROCESS FORMS AND EACH BLOCK IT CONTAINES
   52: 	S $P(DIFRDSV,U,4)="",$P(DIFRDSV,U,6)="" S:'DIFRSEC $P(DIFRDSV,U,2,3)=U
   53: 	S @DIFRTRT@(0)=DIFRDSV
   54: 	D T404
   55: 	K @DIFRTRT@("AZ"),@DIFRTRT@(40,"B"),^("C")
   56: 	N X
   57: 	S X=0
   58: 	F  S X=$O(@DIFRTRT@(40,X)) Q:X'>0  K @DIFRTRT@(40,X,40,"AC"),^("B")
   59: 	Q
   60: 	;
   61: T404	;PROCESS BLOCKS
   62: 	;    :.404
   63: 	;    :BLOCK NAME^
   64: 	N DIFR1,DIFR2,D1,D2
   65: 	S D1=0
   66: 	F  S D1=$O(@DIFRTRT@(40,D1)) Q:'D1  I $D(^(D1,0)) S DIFR1=+$P(^(0),U,2) D
   67: 	.I $D(^DIST(.404,DIFR1,0)) D
   68: 	..S $P(@DIFRTRT@(40,D1,0),U,2)=$P(^DIST(.404,DIFR1,0),U)
   69: 	..M @DIFRTA@(.404,DIFR1)=^DIST(.404,DIFR1)
   70: 	..K @DIFRTA@(.404,DIFR1,40,"B"),^("C"),^("D")
   71: 	..Q
   72: 	.S D2=0
   73: 	.F  S D2=$O(@DIFRTRT@(40,D1,40,D2)) Q:'D2  I $D(^(D2,0)) S DIFR2=+^(0) D
   74: 	..I $D(^DIST(.404,DIFR2)) D
   75: 	...S $P(@DIFRTRT@(40,D1,40,D2,0),U)=$P(^DIST(.404,DIFR2,0),U)
   76: 	...M @DIFRTA@(.404,DIFR2)=^DIST(.404,DIFR2)
   77: 	...K @DIFRTA@(.404,DIFR2,40,"B"),^("C"),^("D")
   78: 	...Q
   79: 	..Q
   80: 	.Q
   81: 	Q
   82: 	;
   83: DIALOG	;
   84: 	Q:'$D(@DIFRTRT@(0))  K ^(4),^(3,"B")
   85: 	Q:$G(DIFRF)'>0
   86: 	S:DIFRF DIFRF=$P($G(^DIC(9.4,DIFRF,0)),"^"),$P(@DIFRTRT@(0),"^",4)=DIFRF
   87: 	Q