source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIAXT.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DIAXT ;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.
4EN N DIAXI,DILL,DIAX
5 S DIAXTTO="^TMP($J,""DIAXTTO"")",DIAXTFR="^TMP($J,""DIAXTFR"")"
6 K @DIAXTTO,@DIAXTFR
7 D SPEC
8 Q
9SPEC ;get specs
10 D TOP,DR
11 D NEXTLVL
12 Q
13TOP ;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)
18FILE 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
27DR ;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
36NEXTLVL ;
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
41NEXTLVL2 ;
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
48RECURSE ;
49 D NEXTLVL
50 Q
Note: See TracBrowser for help on using the repository browser.