| [641] | 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 | ;
|
|---|
