source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTXX11.m@ 1432

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1DGMTXX11 ; COMPILED XREF FOR FILE #408.21 ; 11/06/06
2 ;
3 S DIKZK=2
4 S DIKZ(0)=$G(^DGMT(408.21,DA,0))
5 S X=$P(DIKZ(0),U,2)
6 I X'="" K ^DGMT(408.21,"AI",X,-$P(^DGMT(408.21,DA,0),U),DA)
7 S X=$P(DIKZ(0),U,2)
8 I X'="" K ^DGMT(408.21,"C",$E(X,1,30),DA)
9 S X=$P(DIKZ(0),U,8)
10 I X'="" D E40821^DGRTRIG(DA)
11 S X=$P(DIKZ(0),U,9)
12 I X'="" D E40821^DGRTRIG(DA)
13 S X=$P(DIKZ(0),U,10)
14 I X'="" D E40821^DGRTRIG(DA)
15 S X=$P(DIKZ(0),U,11)
16 I X'="" D E40821^DGRTRIG(DA)
17 S X=$P(DIKZ(0),U,12)
18 I X'="" D E40821^DGRTRIG(DA)
19 S X=$P(DIKZ(0),U,13)
20 I X'="" D E40821^DGRTRIG(DA)
21 S X=$P(DIKZ(0),U,14)
22 I X'="" I $D(^DGMT(408.21,DA,0)),$P(^(0),U,14)="" D EMP^DGMTDD3
23 S X=$P(DIKZ(0),U,14)
24 I X'="" D E40821^DGRTRIG(DA)
25 S X=$P(DIKZ(0),U,15)
26 I X'="" D E40821^DGRTRIG(DA)
27 S X=$P(DIKZ(0),U,16)
28 I X'="" D E40821^DGRTRIG(DA)
29 S X=$P(DIKZ(0),U,17)
30 I X'="" D E40821^DGRTRIG(DA)
31 S DIKZ(1)=$G(^DGMT(408.21,DA,1))
32 S X=$P(DIKZ(1),U,1)
33 I X'="" D AGME101^DGMTSCU4(DA)
34 S X=$P(DIKZ(1),U,1)
35 I X'="" D E40821^DGRTRIG(DA)
36 S X=$P(DIKZ(1),U,2)
37 I X'="" D E40821^DGRTRIG(DA)
38 S X=$P(DIKZ(1),U,3)
39 I X'="" D E40821^DGRTRIG(DA)
40 S DIKZ(2)=$G(^DGMT(408.21,DA,2))
41 S X=$P(DIKZ(2),U,1)
42 I X'="" D E40821^DGRTRIG(DA)
43 S X=$P(DIKZ(2),U,2)
44 I X'="" D E40821^DGRTRIG(DA)
45 S X=$P(DIKZ(2),U,3)
46 I X'="" D E40821^DGRTRIG(DA)
47 S X=$P(DIKZ(2),U,4)
48 I X'="" I $D(^DGMT(408.21,DA,2)),$P(^(2),U,4)="" D OTH^DGMTDD3
49 S X=$P(DIKZ(2),U,4)
50 I X'="" D E40821^DGRTRIG(DA)
51 S X=$P(DIKZ(2),U,5)
52 I X'="" D E40821^DGRTRIG(DA)
53 S DIKZ("MT")=$G(^DGMT(408.21,DA,"MT"))
54 S X=$P(DIKZ("MT"),U,1)
55 I X'="" K ^DGMT(408.21,"AM",$E(X,1,30),DA)
56 S X=$P(DIKZ(0),U,1)
57 I X'="" K ^DGMT(408.21,"B",$E(X,1,30),DA)
58 S X=$P(DIKZ(0),U,1)
59 I X'="" K ^DGMT(408.21,"AI",+$P(^DGMT(408.21,DA,0),U,2),-X,DA)
60 S X=$P(DIKZ(0),U,1)
61 I X'="" D E40821^DGRTRIG(DA)
62END Q
Note: See TracBrowser for help on using the repository browser.