- DGPTX72 ; ;12/08/20
- S X=DG(DQ),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=DG(DQ),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[HDGPTX72 372 printed Jan 18, 2025@03:54:42 Page 2
- DGPTX72 ; ;12/08/20
- +1 SET X=DG(DQ)
- 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=DG(DQ)
- 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)"