IBXS32 ; ;11/02/18
 S X=DE(33),DIC=DIE
 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(399,114,1,1,2.4)
 S X=DE(33),DIC=DIE
 D KIX^IBCNS2(DA,"I3")
 S X=DE(33),DIC=DIE
 X ^DD(399,114,1,3,2.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"MP")):^("MP"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(399,114,1,3,2.4)
 S X=DE(33),DIC=DIE
 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U2")):^("U2"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X="" S DIH=$G(^DGCR(399,DIV(0),"U2")),DIV=X S $P(^("U2"),U,9)=DIV,DIH=399,DIG=231 D ^DICR
 S X=DE(33),DIC=DIE
 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"UF32")):^("UF32"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DGCR(399,DIV(0),"UF32")),DIV=X S $P(^("UF32"),U,3)=DIV,DIH=399,DIG=255 D ^DICR
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBXS32   852     printed  Sep 23, 2025@20:06:35                                                                                                                                                                                                       Page 2
IBXS32    ; ;11/02/18
 +1        SET X=DE(33)
           SET DIC=DIE
 +2        KILL DIV
           SET DIV=X
           SET D0=DA
           SET DIV(0)=D0
           SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"M")):^("M"),1:"")
           SET X=$PIECE(Y(1),U,3)
           SET X=X
           SET DIU=X
           KILL Y
           SET X=""
           XECUTE ^DD(399,114,1,1,2.4)
 +3        SET X=DE(33)
           SET DIC=DIE
 +4        DO KIX^IBCNS2(DA,"I3")
 +5        SET X=DE(33)
           SET DIC=DIE
 +6        XECUTE ^DD(399,114,1,3,2.3)
           IF X
               SET X=DIV
               SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"MP")):^("MP"),1:"")
               SET X=$PIECE(Y(1),U,2)
               SET X=X
               SET DIU=X
               KILL Y
               SET X=""
               XECUTE ^DD(399,114,1,3,2.4)
 +7        SET X=DE(33)
           SET DIC=DIE
 +8        KILL DIV
           SET DIV=X
           SET D0=DA
           SET DIV(0)=D0
           SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"U2")):^("U2"),1:"")
           SET X=$PIECE(Y(1),U,9)
           SET X=X
           SET DIU=X
           KILL Y
           SET X=""
           SET DIH=$GET(^DGCR(399,DIV(0),"U2"))
           SET DIV=X
           SET $PIECE(^("U2"),U,9)=DIV
           SET DIH=399
           SET DIG=231
           DO ^DICR
 +9        SET X=DE(33)
           SET DIC=DIE
 +10       KILL DIV
           SET DIV=X
           SET D0=DA
           SET DIV(0)=D0
           SET Y(1)=$SELECT($DATA(^DGCR(399,D0,"UF32")):^("UF32"),1:"")
           SET X=$PIECE(Y(1),U,3)
           SET X=X
           SET DIU=X
           KILL Y
           SET X=""
           SET DIH=$GET(^DGCR(399,DIV(0),"UF32"))
           SET DIV=X
           SET $PIECE(^("UF32"),U,3)=DIV
           SET DIH=399
           SET DIG=255
           DO ^DICR