source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORD17.m@ 1801

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1ORD17 ; COMPILED XREF FOR FILE #101 ; 04/16/99
2 ;
3 S DIKZK=1
4 S DIKZ(0)=$G(^ORD(101,DA,0))
5 S X=$P(DIKZ(0),U,1)
6 I X'="" S ^ORD(101,"B",$E(X,1,63),DA)=""
7 S X=$P(DIKZ(0),U,1)
8 I X'="" D
9 .N DIK,DIV,DIU,DIN
10 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ORD(101,D0,0)):^(0),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(101,.01,1,2,1.4)
11 S X=$P(DIKZ(0),U,2)
12 I X'="" S ORKX=X D UP^ORDD1 S ^ORD(101,"C",$E(X,1,63),DA)="",X=ORKX K ORKX
13 S X=$P(DIKZ(0),U,2)
14 I X'="" D REDO^ORDD101
15 S X=$P(DIKZ(0),U,2)
16 I X'="" D K11^ORDD1
17 S DIKZ(5)=$G(^ORD(101,DA,5))
18 S X=$P(DIKZ(5),U,1)
19 I X'="" S ^ORD(101,"AE",$E(X,1,30),DA)=""
20 S DIKZ(4)=$G(^ORD(101,DA,4))
21 S X=$P(DIKZ(4),U,1)
22 I X'="" D REDO^ORDD101
23 S DIKZ(99)=$G(^ORD(101,DA,99))
24 S X=$P(DIKZ(99),U,1)
25 I X'="" D SET^ORDD101
26 S DIKZ(770)=$G(^ORD(101,DA,770))
27 S X=$P(DIKZ(770),U,1)
28 I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) S:$P(HL770,"^",3)&($P(HL770,"^",4)) ^ORD(101,"AHL1",X,$P(HL770,"^",3),$P(HL770,"^",4),DA)=""
29 S X=$P(DIKZ(770),U,2)
30 I X'="" S ^ORD(101,"AHL2",$E(X,1,30),DA)=""
31 S X=$P(DIKZ(770),U,3)
32 I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) S:$P(HL770,"^")&($P(HL770,"^",4)) ^ORD(101,"AHL1",$P(HL770,"^"),X,$P(HL770,"^",4),DA)=""
33 S X=$P(DIKZ(770),U,4)
34 I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) S:$P(HL770,"^")&($P(HL770,"^",3)) ^ORD(101,"AHL1",$P(HL770,"^"),$P(HL770,"^",3),X,DA)=""
35END G ^ORD18
Note: See TracBrowser for help on using the repository browser.