source: IHS-VA_UTILITIES-XB/trunk/XBTM5.m@ 901

Last change on this file since 901 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.4 KB
RevLine 
[641]1XBTM5 ; IHS/ADC/GTH - TECH MANUAL : FIELDS IN THE FILES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 NEW A,B,C,I,J
5 F A=1:1 S X=$P($T(PR+A),";;",2) Q:X="###" D PR(X) Q:$D(DUOUT)
6 Q:$D(DUOUT)
7 D ^DIWW
8 KILL ^TMP("XBTM-FIF",$J)
9 S DIWF="WN"
10 D PR($J("",5)_"These are the files in the package:")
11 Q:$D(DUOUT)
12 D ALPHA
13 D PR($J("",5)),PR($J("",5)),PR($J("",5)_"These are the alphabetized fields in the files :")
14 Q:$D(DUOUT)
15 S DIWF="W",(A,B,I,J)=""
16 F S A=$O(^TMP("XBTM-FIF",$J,A)) Q:A="" S B=$O(^(A,0)),I=$O(^(B,0)) D Q:$D(DUOUT)
17 . D PR(A_$E($J("",40),1,(40-$L(A)))_B_$E($J("",12),1,(12-$L(B)))_I),^DIWW
18 . S J=J+1
19 .Q
20 Q:$D(DUOUT)
21 D PR($J("",5)),PR($J("",5)),PR($J("",3)_"There are "_+J_" fields in the package files.")
22 Q:$D(DUOUT)
23 D ^DIWW
24 Q
25 ;
26PR(X) NEW %,A,B,C,I,J D PR^XBTM(X) Q
27 ;;No files are distributed with this package. Any fields listed,
28 ;;below, will have been created locally. The list will be
29 ;;an alphabetical list of fields in the package's files.
30 ;;|SETTAB("C")||TAB|
31 ;;|SETTAB("C")||TAB|
32 ;;###
33 ;
34ALPHA ;
35 NEW XBFLD,XBPIEN
36 S XBPIEN=$O(^DIC(9.4,"C","XB",0))
37 S %=0
38 F S %=$O(^DIC(9.4,XBPIEN,4,"B",%)) Q:'% D PR(%_$E(" ",1,(12-$L(%)))_$O(^DD(%,0,"NM",""))) Q:$D(DUOUT) D FLD
39 Q
40 ;
41FLD ;
42 S XBFLD=0
43 F S XBFLD=$O(^DD(%,XBFLD)) Q:'XBFLD D
44 .I +$P(^DD(%,XBFLD,0),U,2) S XB=+$P(^(0),U,2) D Q
45 ..NEW %,XBFLD
46 ..S %=XB
47 ..D FLD
48 ..Q
49 .S ^TMP("XBTM-FIF",$J,$P(^DD(%,XBFLD,0),U),%,XBFLD)=""
50 .Q
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.