IBXSAH3.m

IBXSAH3 ; ;11/02/18

 S X=DE(81),DIC=DIE

 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M2")):^("M2"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" S DIH=$G(^DGCR(399,DIV(0),"M2")),DIV=X S $P(^("M2"),U,4)=DIV,DIH=399,DIG=143 D ^DICR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBXSAH3   246     printed  Apr 09, 2024@21:09:30                                                                                                                                                                                                      Page 2

IBXSAH3   ; ;11/02/18

 +1        SET X=DE(81)

           SET DIC=DIE

 +2        KILL DIV

           SET DIV=X

           SET D0=DA

           SET DIV(0)=D0

           SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M2")):^("M2"),1:"")

           SET X=$PIECE(Y(1),U,4)

           SET X=X

           SET DIU=X

           KILL Y

           SET X=""

           SET DIH=$GET(^DGCR(399,DIV(0),"M2"))

           SET DIV=X

           SET $PIECE(^("M2"),U,4)=DIV

           SET DIH=399

           SET DIG=143

           DO ^DICR