source: IHS-VA_UTILITIES-XB/trunk/XBKD1.m@ 1177

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

Modified directory structure; moved routines.

File size: 1.0 KB
Line 
1XBKD1 ; IHS/ADC/GTH - XBKD SUBROUTINES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Part of XBKD
5 ;
6BX ;
7 KILL A
8 S (I,C)=""
9 F J=1:1 S I=$O(^DIC("B",I)) Q:I="" I $D(^(I,N)) S C=C+1,A(C)=I
10 I 'C S C=$O(^DD(N,"NM","")) I C]"" S A=C,C=1,A(C)=A
11 Q
12 ;
13NCK ;
14 G NCKER:'$D(^DIC(N,0)),NCKER:+$P(^(0),"^",2)'=N
15 I $D(^DIC(N,0,"GL")) S G=^("GL") G NCKOK:G?1"^DIC(".E
16 I @("$D("_G_"0))"),+$P(^(0),"^",2)=N G NCKOK
17NCKER ;
18 S E=1
19 Q
20 ;
21NCKOK ;
22 S E=0
23 Q
24 ;
25FGLB ;
26 G FGOK:'$D(^DD(N,.01,1))
27 S I=0
28 F J=1:1 S I=$O(^DD(N,.01,1,I)) Q:I="" I $D(^(I,1)) S X=^(1) D SB1 G FGOK:G]""
29 S G=""
30FGOK ;
31 Q
32 ;
33END ;
34 Q
35 ;
36TEMPLP ;
37 F TEMP="^DIE(","^DIBT(","^DIPT(" D TEMP
38 Q
39 ;
40TEMP ;
41 S XBKDB="F"_XBKDFILE,XBKDA=""
42TEMP1 ;
43 S @("XBKDA=$O("_TEMP_"XBKDB,XBKDA))")
44 G TEMPE:XBKDA=""
45 S DA=""
46TEMP2 ;
47 S @("DA=$O("_TEMP_"XBKDB,XBKDA,DA))")
48 G TEMP1:DA=""
49 S DIE=TEMP,DR=".01" ;D ^DIE
50 W !,DIE,?8,DA,?12,XBKDB,?24,XBKDA
51 G TEMP2
52 ;
53TEMPE ;
54 KILL XBKDA,XBKDB
55 Q
56 ;
57SB1 ;
58 S G=""
59 I X'?1"S ^"1UP.U1"(".N1",""B""".E
60 S G=$E($P(X,"""B""",1),3,999)
61 Q
62 ;
Note: See TracBrowser for help on using the repository browser.