| [613] | 1 | DIAXT ;SFISC/DCM-GET EXTRACT TEMPLATE SPECS ;5/13/96 14:01
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN N DIAXI,DILL,DIAX
|
|---|
| 5 | S DIAXTTO="^TMP($J,""DIAXTTO"")",DIAXTFR="^TMP($J,""DIAXTFR"")"
|
|---|
| 6 | K @DIAXTTO,@DIAXTFR
|
|---|
| 7 | D SPEC
|
|---|
| 8 | Q
|
|---|
| 9 | SPEC ;get specs
|
|---|
| 10 | D TOP,DR
|
|---|
| 11 | D NEXTLVL
|
|---|
| 12 | Q
|
|---|
| 13 | TOP ;get base file specs from extract template
|
|---|
| 14 | N X
|
|---|
| 15 | S DIAXI=0
|
|---|
| 16 | S DIAXI=$O(^DIPT(DIAXT,1,DIAXI)) Q:DIAXI'>0 S X=^(DIAXI,0)
|
|---|
| 17 | S DILL=$P(X,U,2)
|
|---|
| 18 | FILE S @DIAXTFR@(DIAXI,"FR")=+X
|
|---|
| 19 | S @DIAXTFR@(+X,"TO")=$P(X,U,9)
|
|---|
| 20 | S @DIAXTFR@(+X,"PRT")=$P(X,U,3)
|
|---|
| 21 | S @DIAXTFR@(+X,"P4")=$P(X,U,4)
|
|---|
| 22 | S @DIAXTFR@(+X,"P2")=$P(X,U,2)
|
|---|
| 23 | S @DIAXTFR@(+X,"P5")=$P(X,U,5)
|
|---|
| 24 | S @DIAXTFR@(+X,"P7")=$P(X,U,7)
|
|---|
| 25 | I DILL>1,$P(X,U,9)'=$P(X,U,10) S @DIAXTTO@(+$P(X,U,9),"PRT")=+$P(X,U,10)
|
|---|
| 26 | Q
|
|---|
| 27 | DR ;get fields
|
|---|
| 28 | N DR,DRN,DRX,DRZ,FILE
|
|---|
| 29 | S DR="",DRN=1,DRZ=0,FILE=@DIAXTFR@(DILL,"FR")
|
|---|
| 30 | F S DRZ=$O(^DIPT(DIAXT,1,DIAXI,"F",DRZ)) Q:'DRZ I $D(^(DRZ,0)) S DRX=^(0) D
|
|---|
| 31 | . S DR=DR_+DRX_";",FILE=@DIAXTFR@(DIAXI,"FR")
|
|---|
| 32 | . S @DIAXTTO@(FILE,+DRX,+$P(DRX,U,5))=@DIAXTFR@(FILE,"TO")_U_$P(DRX,U,3)_U_$P(DRX,U,5)
|
|---|
| 33 | . I $L(DR)>245 S @DIAXTFR@(FILE,"DR",DRN)=DR,DRN=DRN+1,DR=""
|
|---|
| 34 | S:DR]"" @DIAXTFR@(FILE,"DR",DRN)=DR
|
|---|
| 35 | Q
|
|---|
| 36 | NEXTLVL ;
|
|---|
| 37 | S DIAX(DILL,"DIAXI")=DIAXI,DILL=DILL+1
|
|---|
| 38 | F DIAXI=DIAXI:0 S DIAXI=$O(^DIPT(DIAXT,1,DIAXI)) Q:DIAXI'=+DIAXI S X=^(DIAXI,0) D NEXTLVL2 Q:DIAXI=""
|
|---|
| 39 | S DILL=DILL-1,DIAXI=DIAX(DILL,"DIAXI")
|
|---|
| 40 | Q
|
|---|
| 41 | NEXTLVL2 ;
|
|---|
| 42 | I $P(X,U,2)<DILL S DIAXI="" Q
|
|---|
| 43 | Q:$P(X,U,3)'=@DIAXTFR@(DIAX(DILL-1,"DIAXI"),"FR")
|
|---|
| 44 | D FILE
|
|---|
| 45 | D DR
|
|---|
| 46 | D RECURSE
|
|---|
| 47 | Q
|
|---|
| 48 | RECURSE ;
|
|---|
| 49 | D NEXTLVL
|
|---|
| 50 | Q
|
|---|
