source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORD2.m@ 1240

Last change on this file since 1240 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.5 KB
Line 
1ORD2 ; DRIVER FOR COMPILED XREFS FOR FILE #100 ; 12/25/06
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
7DI 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)=100,DIKUP=DA
9 I $D(DIKKS) D:DIKZ1=DH(1) ^ORD21 S DA=DIKUP D:DIKZ1=DH(1) ^ORD29 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) ^ORD21 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) ^ORD29 D:DIKZ1'=DH(1) SET D DA Q
12 I $D(DIKSAT) D SET1 D DA Q
13 Q
14DA K DA F DV=1:1 Q:'$D(DIKUP(DV)) S DA(DV)=DIKUP(DV)
15 S DA=DIKUP Q
16SET1 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
18C 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) ^ORD29 D:DIKZ1'=DH(1) SET D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C
20 Q
21C1(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
24KILL S DIKILL=1,DIKZK=2
25 I DIKZ1=100.001,DIKUM'<1 S DIKM1=1 D A1^ORD22 Q
26 I DIKZ1=100.002,DIKUM'<1 S DIKM1=1 D A1^ORD23 Q
27 I DIKZ1=100.008,DIKUM'<1 S DIKM1=1 D A1^ORD24 Q
28 I DIKZ1=100.04,DIKUM'<1 S DIKM1=1 D A1^ORD25 Q
29 I DIKZ1=100.045,DIKUM'<1 S DIKM1=1 D A1^ORD26 Q
30 I DIKZ1=100.051,DIKUM'<1 S DIKM1=1 D A1^ORD27 Q
31 I DIKZ1=100.09,DIKUM'<1 S DIKM1=1 D A1^ORD28 Q
32 Q
33SET S DISET=1,DIKZK=1 K DIKPUSH
34 I DIKZ1=100.001,DIKUM'<1 S DIKM1=1 D A1^ORD210 Q
35 I DIKZ1=100.002,DIKUM'<1 S DIKM1=1 D A1^ORD211 Q
36 I DIKZ1=100.008,DIKUM'<1 S DIKM1=1 D A1^ORD212 Q
37 I DIKZ1=100.04,DIKUM'<1 S DIKM1=1 D A1^ORD213 Q
38 I DIKZ1=100.045,DIKUM'<1 S DIKM1=1 D A1^ORD214 Q
39 I DIKZ1=100.051,DIKUM'<1 S DIKM1=1 D A1^ORD215 Q
40 I DIKZ1=100.09,DIKUM'<1 S DIKM1=1 D A1^ORD216 Q
41 Q
42KIL1 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
46Q K DIKGP,DIKZ1 Q
47 ;
483 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
50L S X=$O(^(DU)) Q:X>0 S DU=DU-DV,DV=DV+1 S:DU<0 DU=0 G L
51 Q
52BUL 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
54END Q
Note: See TracBrowser for help on using the repository browser.