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

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

initial load of WorldVistAEHR

File size: 672 bytes
RevLine 
[613]1DGPTXX13 ; COMPILED XREF FOR FILE #45.0535 ; 12/27/07
2 ;
3 S DA=0
4A1 ;
5 I $D(DISET) K DIKLM S:DIKM1=1 DIKLM=1 G @DIKM1
60 ;
7A S DA=$O(^DGPT(DA(1),535,DA)) I DA'>0 S DA=0 G END
81 ;
9 S DIKZ(0)=$G(^DGPT(DA(1),535,DA,0))
10 S X=$P(DIKZ(0),U,2)
11 I X'="" D
12 .N DIK,DIV,DIU,DIN
13 .K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,535,D1,0)):^(0),1:"") S X=$P(Y(1),U,16),X=X S DIU=X K Y X ^DD(45.0535,2,1,1,1.1) X ^DD(45.0535,2,1,1,1.4)
14 S DIKZ(0)=$G(^DGPT(DA(1),535,DA,0))
15 S X=$P(DIKZ(0),U,7)
16 I X'="" S ^DGPT(DA(1),535,"ADC",$E(X,1,30),DA)=""
17 S X=$P(DIKZ(0),U,10)
18 I X'="" S ^DGPT(DA(1),535,"AM",$E(X,1,30),DA)=""
19 G:'$D(DIKLM) A Q:$D(DISET)
20END G ^DGPTXX14
Note: See TracBrowser for help on using the repository browser.