Return to DIFROMS5.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIFROMS5	;SCISC/DCL-DIFROM SERVER PROCESS TEMPLATES OUT;08:07 AM  1 Dec 1994;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	Q
	;
EDEOUT	;EXTENDED DATABASE ELEMENTS OUT
	N DIFRDSV,DIFRF,DIFRGBL,DIFRSEC,DIFRTRT
	I $G(DIFRIEN)>0 G EDE
	N DIFRIENX,DIFRIENZ
	S DIFRIENX=$O(@DIFRLST@(0)),DIFRIENZ=$D(@DIFRLST@(DIFRIENX,0))#2,DIFRIENX=0
	F  S DIFRIENX=$O(@DIFRLST@(DIFRIENX)) Q:DIFRIENX'>0  D
	.I DIFRIENZ S DIFRIEN=+@DIFRLST@(DIFRIENX,0) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
	.S DIFRIEN=+@DIFRLST@(DIFRIENX) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
	Q
EDE	;
	;  DIFRTRT=FULL ROOT IN DIST ARRAY
	;  DIFRDSV=0TH NODE OF TEMPLATE
	;         :.401, .4, .402
	;         :TEMPL NAME^DATE CREATED^READ^FILENR^DUZ^WRITE^DATE LAST USED
	;         :.403
	;         :FORM NAME^READ^WRITE^DUZ^DATE CREATED^DATA LAST USED^^FILE^
	;         :.84
	;         :DIALOG NUMBER^TYPE^INTERNAL PARM^PACKAGE FILE (pointer)
	;  DIFRSEC=FILE SECURITY 1=EXPORT SECURITY,0=NO FILE SECURITY
	;  DIFRIEN=TEMPLATE'S INTERNAL ENTRY NUMBER
	;         :.5 (FUNCTIONS)
	S DIFRTRT=$NA(@DIFRTA@(DIFRFILE,DIFRIEN))
	S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1)
	; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	;
	; For stand alone FileMan only - KIDS will do the Merge
	; 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
	;
	I $G(DIFRSTNA) S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1) M @DIFRTRT=@DIFRGBL@(DIFRIEN)
	;
	; ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
	; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	I DIFRFILE=.5 Q  ;no processing necessary
	S DIFRDSV=$G(@DIFRTRT@(0)),DIFRF=$P(DIFRDSV,U,$S(DIFRFILE=.403:8,1:4))
	I DIFRDSV="" D  Q
	.N DIFRERR S DIFRERR(1)=DIFRFNAM,DIFRERR(2)=DIFRIEN
	.D BLD^DIALOG(9516,.DIFRERR)
	.Q
	I DIFRFILE=.84 G DIALOG
	S DIFRSEC=$TR($P($G(@DIFRFIA@(DIFRF,0,1)),U,2),"y","Y")="Y"
	I DIFRFILE=.403 G T403
	Q:'$D(@DIFRTRT@(0))  K ^("RD"),^("AB") K:DIFRFILE=.401 ^(1)
	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)
	Q
	;
T403	;PROCESS FORMS AND EACH BLOCK IT CONTAINES
	S $P(DIFRDSV,U,4)="",$P(DIFRDSV,U,6)="" S:'DIFRSEC $P(DIFRDSV,U,2,3)=U
	S @DIFRTRT@(0)=DIFRDSV
	D T404
	K @DIFRTRT@("AZ"),@DIFRTRT@(40,"B"),^("C")
	N X
	S X=0
	F  S X=$O(@DIFRTRT@(40,X)) Q:X'>0  K @DIFRTRT@(40,X,40,"AC"),^("B")
	Q
	;
T404	;PROCESS BLOCKS
	;    :.404
	;    :BLOCK NAME^
	N DIFR1,DIFR2,D1,D2
	S D1=0
	F  S D1=$O(@DIFRTRT@(40,D1)) Q:'D1  I $D(^(D1,0)) S DIFR1=+$P(^(0),U,2) D
	.I $D(^DIST(.404,DIFR1,0)) D
	..S $P(@DIFRTRT@(40,D1,0),U,2)=$P(^DIST(.404,DIFR1,0),U)
	..M @DIFRTA@(.404,DIFR1)=^DIST(.404,DIFR1)
	..K @DIFRTA@(.404,DIFR1,40,"B"),^("C"),^("D")
	..Q
	.S D2=0
	.F  S D2=$O(@DIFRTRT@(40,D1,40,D2)) Q:'D2  I $D(^(D2,0)) S DIFR2=+^(0) D
	..I $D(^DIST(.404,DIFR2)) D
	...S $P(@DIFRTRT@(40,D1,40,D2,0),U)=$P(^DIST(.404,DIFR2,0),U)
	...M @DIFRTA@(.404,DIFR2)=^DIST(.404,DIFR2)
	...K @DIFRTA@(.404,DIFR2,40,"B"),^("C"),^("D")
	...Q
	..Q
	.Q
	Q
	;
DIALOG	;
	Q:'$D(@DIFRTRT@(0))  K ^(4),^(3,"B")
	Q:$G(DIFRF)'>0
	S:DIFRF DIFRF=$P($G(^DIC(9.4,DIFRF,0)),"^"),$P(@DIFRTRT@(0),"^",4)=DIFRF
	Q