| 1 | IBXX ; DRIVER FOR COMPILED XREFS FOR FILE #399 ; 07/22/08
|
|---|
| 2 | ;
|
|---|
| 3 | N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2
|
|---|
| 4 | I '$D(DIKSAT) S DIKLK=DIK_DA_")" L +@DIKLK:10 K:'$T DIKLK
|
|---|
| 5 | D DI I '$D(DIKSAT),$D(DIKLK) L -@DIKLK
|
|---|
| 6 | G Q
|
|---|
| 7 | DI S DIKM1=0,DIKUM=0,DA(0)="",DV=0 F S DV=$O(DA(DV)) Q:DV'>0 S DIKUM=DIKUM+1,DIKUP(DV)=DA(DV)
|
|---|
| 8 | S:DV="" DV=-1 S DH(1)=399,DIKUP=DA
|
|---|
| 9 | I $D(DIKKS) D:DIKZ1=DH(1) ^IBXX1 S DA=DIKUP D:DIKZ1=DH(1) ^IBXX15 D:DIKZ1'=DH(1) KILL D:DIKZ1'=DH(1) DA D:DIKZ1'=DH(1) SET D DA Q
|
|---|
| 10 | I $D(DIKIL) D:DIKZ1=DH(1) ^IBXX1 S:DIKZ1=DH(1) DIKM1=1 D:DIKZ1'=DH(1) KILL S DA=DIKUP D:DIKM1>0 KIL1 D DA Q
|
|---|
| 11 | I $D(DIKST) D:DIKZ1=DH(1) ^IBXX15 D:DIKZ1'=DH(1) SET D DA Q
|
|---|
| 12 | I $D(DIKSAT) D SET1 D DA Q
|
|---|
| 13 | Q
|
|---|
| 14 | DA K DA F DV=1:1 Q:'$D(DIKUP(DV)) S DA(DV)=DIKUP(DV)
|
|---|
| 15 | S DA=DIKUP Q
|
|---|
| 16 | SET1 S (DA,DCNT)=0
|
|---|
| 17 | S DU=$E(DIK,1,$L(DIK)-1),DIKLK=$S(DIK[",":DU_")",1:DU) L +@DIKLK:10 K:'$T DIKLK
|
|---|
| 18 | C I @("$O("_DIK_"DA))'>0") S DA=$$C1(DA),^(0)=$P(@(DIK_"0)"),U,1,2)_U_DA_U_DCNT K DCNT L:$D(DIKLK) -@DIKLK Q
|
|---|
| 19 | S (DIKY,DA)=$O(^(DA)) G C:$P($G(^(DA,0)),U)']"" S DU=1,DCNT=DCNT+1 S:DA="" (DIKY,DA)=-1 D:DIKZ1=DH(1) ^IBXX15 D:DIKZ1'=DH(1) SET D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C
|
|---|
| 20 | Q
|
|---|
| 21 | C1(A) Q:$P($G(@(DIK_"A,0)")),U)]"" A
|
|---|
| 22 | F S @("A=+$O("_DIK_"A),-1)") Q:$P($G(@(DIK_"A,0)")),U)]""!(A'>0)
|
|---|
| 23 | Q A
|
|---|
| 24 | KILL S DIKILL=1,DIKZK=2
|
|---|
| 25 | I DIKZ1=399.0222,DIKUM'<1 S DIKM1=1 D A1^IBXX3 Q
|
|---|
| 26 | I DIKZ1=399.0304,DIKUM'<1 S DIKM1=1 D A1^IBXX4,A1^IBXX14 Q
|
|---|
| 27 | I DIKZ1=399.041,DIKUM'<1 S DIKM1=1 D A1^IBXX5 Q
|
|---|
| 28 | I DIKZ1=399.042,DIKUM'<1 S DIKM1=1 D A1^IBXX6 Q
|
|---|
| 29 | I DIKZ1=399.043,DIKUM'<1 S DIKM1=1 D A1^IBXX7 Q
|
|---|
| 30 | I DIKZ1=399.044,DIKUM'<1 S DIKM1=1 D A1^IBXX8 Q
|
|---|
| 31 | I DIKZ1=399.045,DIKUM'<1 S DIKM1=1 D A1^IBXX9 Q
|
|---|
| 32 | I DIKZ1=399.046,DIKUM'<1 S DIKM1=1 D A1^IBXX10 Q
|
|---|
| 33 | I DIKZ1=399.047,DIKUM'<1 S DIKM1=1 D A1^IBXX11 Q
|
|---|
| 34 | I DIKZ1=399.048,DIKUM'<1 S DIKM1=1 D A1^IBXX12 Q
|
|---|
| 35 | I DIKZ1=399.077,DIKUM'<1 S DIKM1=1 D A1^IBXX13 Q
|
|---|
| 36 | I DIKZ1=399.30416,DIKUM'<2 S DIKM1=2 D A1^IBXX14 Q
|
|---|
| 37 | Q
|
|---|
| 38 | SET S DISET=1,DIKZK=1 K DIKPUSH
|
|---|
| 39 | I DIKZ1=399.0222,DIKUM'<1 S DIKM1=1 D A1^IBXX19 Q
|
|---|
| 40 | I DIKZ1=399.0304,DIKUM'<1 S DIKM1=1 D A1^IBXX20,A1^IBXX30 Q
|
|---|
| 41 | I DIKZ1=399.041,DIKUM'<1 S DIKM1=1 D A1^IBXX21 Q
|
|---|
| 42 | I DIKZ1=399.042,DIKUM'<1 S DIKM1=1 D A1^IBXX22 Q
|
|---|
| 43 | I DIKZ1=399.043,DIKUM'<1 S DIKM1=1 D A1^IBXX23 Q
|
|---|
| 44 | I DIKZ1=399.044,DIKUM'<1 S DIKM1=1 D A1^IBXX24 Q
|
|---|
| 45 | I DIKZ1=399.045,DIKUM'<1 S DIKM1=1 D A1^IBXX25 Q
|
|---|
| 46 | I DIKZ1=399.046,DIKUM'<1 S DIKM1=1 D A1^IBXX26 Q
|
|---|
| 47 | I DIKZ1=399.047,DIKUM'<1 S DIKM1=1 D A1^IBXX27 Q
|
|---|
| 48 | I DIKZ1=399.048,DIKUM'<1 S DIKM1=1 D A1^IBXX28 Q
|
|---|
| 49 | I DIKZ1=399.077,DIKUM'<1 S DIKM1=1 D A1^IBXX29 Q
|
|---|
| 50 | I DIKZ1=399.30416,DIKUM'<2 S DIKM1=2 D A1^IBXX30 Q
|
|---|
| 51 | Q
|
|---|
| 52 | KIL1 K @(DIK_"DA)") Q:'$D(^(0))
|
|---|
| 53 | S Y=^(0),DH=$S($O(^(0))'>0:0,1:$P(Y,U,4)-1),X=$P($P(Y,U,3),U,DH>0) D 3:X=DA
|
|---|
| 54 | S ^(0)=$P(Y,U,1,2)_U_X_U_DH
|
|---|
| 55 | Q
|
|---|
| 56 | Q K DIKGP,DIKZ1 Q
|
|---|
| 57 | ;
|
|---|
| 58 | 3 I X>1,$D(^(X-1)) S X=X-1 Q
|
|---|
| 59 | S DV=1 F X=X:1 S X=X+DV,DV=DV+1 I $O(^(X))'>0 S DU=X-2,DV=1 Q
|
|---|
| 60 | L S X=$O(^(DU)) Q:X>0 S DU=DU-DV,DV=DV+1 S:DU<0 DU=0 G L
|
|---|
| 61 | Q
|
|---|
| 62 | BUL S DIKOZ=1,DIKZA=$P("CREA^DELE",U,DIKZK)_"TE VALUE"
|
|---|
| 63 | I $D(^DD(DIKZ1,DIKZZ,1,DIKZR,DIKZA)) W "...(`",^(DIKZA),"` BULLETIN WILL NOT BE TRIGGERED) " Q
|
|---|
| 64 | END Q
|
|---|
