1 | PSJXR5 ; DRIVER FOR COMPILED XREFS FOR FILE #55 ; 10/28/97
|
---|
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
|
---|
4 | S DIKLK=DIK_DA_")" L @("+"_DIKLK) D DI L @("-"_DIKLK) G Q
|
---|
5 | 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)
|
---|
6 | S:DV="" DV=-1 S DH(1)=55,DIKUP=DA
|
---|
7 | I $D(DIKKS) D:DIKZ1=DH(1) ^PSJXR51 S DA=DIKUP D:DIKZ1=DH(1) ^PSJXR511 D:DIKZ1'=DH(1) KILL D:DIKZ1'=DH(1) DA D:DIKZ1'=DH(1) SET D DA Q
|
---|
8 | I $D(DIKIL) D:DIKZ1=DH(1) ^PSJXR51 S:DIKZ1=DH(1) DIKM1=1 D:DIKZ1'=DH(1) KILL S DA=DIKUP D:DIKM1>0 KIL1 D DA Q
|
---|
9 | I $D(DIKST) D:DIKZ1=DH(1) ^PSJXR511 D:DIKZ1'=DH(1) SET D DA Q
|
---|
10 | I $D(DIKSAT) D SET1 D DA Q
|
---|
11 | Q
|
---|
12 | DA K DA F DV=1:1 Q:'$D(DIKUP(DV)) S DA(DV)=DIKUP(DV)
|
---|
13 | S DA=DIKUP Q
|
---|
14 | SET1 S (DA,DCNT)=0
|
---|
15 | S DU=$E(DIK,1,$L(DIK)-1),DIKLK=$S(DIK[",":DU_")",1:DU) L @("+"_DIKLK)
|
---|
16 | C I @("$O("_DIK_"DA))'>0") S DA=$$C1(DA),^(0)=$P(@(DIK_"0)"),U,1,2)_U_DA_U_DCNT K DCNT L @("-"_DIKLK) Q
|
---|
17 | 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) ^PSJXR511 D:DIKZ1'=DH(1) SET D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C
|
---|
18 | Q
|
---|
19 | C1(A) Q:$P($G(@(DIK_"A,0)")),U)]"" A
|
---|
20 | F S @("A=+$O("_DIK_"A),-1)") Q:$P($G(@(DIK_"A,0)")),U)]""!(A'>0)
|
---|
21 | Q A
|
---|
22 | KILL S DIKILL=1,DIKZK=2
|
---|
23 | I DIKZ1=55.01,DIKUM'<1 S DIKM1=1 D A1^PSJXR52,A1^PSJXR56,A1^PSJXR510 Q
|
---|
24 | I DIKZ1=55.02,DIKUM'<2 S DIKM1=2 D A1^PSJXR56 Q
|
---|
25 | I DIKZ1=55.03,DIKUM'<1 S DIKM1=1 D A1^PSJXR53 Q
|
---|
26 | I DIKZ1=55.06,DIKUM'<1 S DIKM1=1 D A1^PSJXR54,A1^PSJXR57,A1^PSJXR58,A1^PSJXR59 Q
|
---|
27 | I DIKZ1=55.0611,DIKUM'<2 S DIKM1=2 D A1^PSJXR57 Q
|
---|
28 | I DIKZ1=55.07,DIKUM'<2 S DIKM1=2 D A1^PSJXR58 Q
|
---|
29 | I DIKZ1=55.09,DIKUM'<2 S DIKM1=2 D A1^PSJXR59 Q
|
---|
30 | I DIKZ1=55.11,DIKUM'<2 S DIKM1=2 D A1^PSJXR510 Q
|
---|
31 | Q
|
---|
32 | SET S DISET=1,DIKZK=1
|
---|
33 | I DIKZ1=55.01,DIKUM'<1 S DIKM1=1 D A1^PSJXR512,A1^PSJXR516,A1^PSJXR520 Q
|
---|
34 | I DIKZ1=55.02,DIKUM'<2 S DIKM1=2 D A1^PSJXR516 Q
|
---|
35 | I DIKZ1=55.03,DIKUM'<1 S DIKM1=1 D A1^PSJXR513 Q
|
---|
36 | I DIKZ1=55.06,DIKUM'<1 S DIKM1=1 D A1^PSJXR514,A1^PSJXR517,A1^PSJXR518,A1^PSJXR519 Q
|
---|
37 | I DIKZ1=55.0611,DIKUM'<2 S DIKM1=2 D A1^PSJXR517 Q
|
---|
38 | I DIKZ1=55.07,DIKUM'<2 S DIKM1=2 D A1^PSJXR518 Q
|
---|
39 | I DIKZ1=55.09,DIKUM'<2 S DIKM1=2 D A1^PSJXR519 Q
|
---|
40 | I DIKZ1=55.11,DIKUM'<2 S DIKM1=2 D A1^PSJXR520 Q
|
---|
41 | Q
|
---|
42 | KIL1 K @(DIK_"DA)") Q:'$D(^(0))
|
---|
43 | 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
|
---|
44 | S ^(0)=$P(Y,U,1,2)_U_X_U_DH
|
---|
45 | Q
|
---|
46 | Q K DIKGP,DIKZ1 Q
|
---|
47 | ;
|
---|
48 | 3 I X>1,$D(^(X-1)) S X=X-1 Q
|
---|
49 | 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
|
---|
50 | L S X=$O(^(DU)) Q:X>0 S DU=DU-DV,DV=DV+1 S:DU<0 DU=0 G L
|
---|
51 | Q
|
---|
52 | BUL S DIKOZ=1,DIKZA=$P("CREA^DELE",U,DIKZK)_"TE VALUE"
|
---|
53 | I $D(^DD(DIKZ1,DIKZZ,1,DIKZR,DIKZA)) W "...(`",^(DIKZA),"` BULLETIN WILL NOT BE TRIGGERED) " Q
|
---|
54 | END Q
|
---|