DGPTX71 ; ;12/08/20
S X=DE(66),DIC=DIE
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,7)=DIV,DIH=45,DIG=82.07 D ^DICR
S X=DE(66),DIC=DIE
X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTX71 372 printed Nov 22, 2024@18:04 Page 2
DGPTX71 ; ;12/08/20
+1 SET X=DE(66)
SET DIC=DIE
+2 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^DGPT(D0,82)):^(82),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
SET X=""
SET DIH=$GET(^DGPT(DIV(0),82))
SET DIV=X
SET $PIECE(^(82),U,7)=DIV
SET DIH=45
SET DIG=82.07
DO ^DICR
+3 SET X=DE(66)
SET DIC=DIE
+4 XECUTE "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
