source: IHS-VA_UTILITIES-XB/XBTM5.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.4 KB
Line 
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.