| [613] | 1 | DIFROMS5 ;SCISC/DCL-DIFROM SERVER PROCESS TEMPLATES OUT ;1:40 PM 4 Sep 1998
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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=DIFRFLG'["S"
|
|---|
| 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,9)
|
|---|
| 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@("AY"),@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
|
|---|
