1 | XBKD1 ; 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 | ;
|
---|
6 | BX ;
|
---|
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 | ;
|
---|
13 | NCK ;
|
---|
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
|
---|
17 | NCKER ;
|
---|
18 | S E=1
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | NCKOK ;
|
---|
22 | S E=0
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | FGLB ;
|
---|
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=""
|
---|
30 | FGOK ;
|
---|
31 | Q
|
---|
32 | ;
|
---|
33 | END ;
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | TEMPLP ;
|
---|
37 | F TEMP="^DIE(","^DIBT(","^DIPT(" D TEMP
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | TEMP ;
|
---|
41 | S XBKDB="F"_XBKDFILE,XBKDA=""
|
---|
42 | TEMP1 ;
|
---|
43 | S @("XBKDA=$O("_TEMP_"XBKDB,XBKDA))")
|
---|
44 | G TEMPE:XBKDA=""
|
---|
45 | S DA=""
|
---|
46 | TEMP2 ;
|
---|
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 | ;
|
---|
53 | TEMPE ;
|
---|
54 | KILL XBKDA,XBKDB
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | SB1 ;
|
---|
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 | ;
|
---|