IBXSC711.m

IBXSC711 ; ;08/13/09

 S X=DE(12),DIC=DIE

 K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGCR(399,D0,"RC",D1,0)):^(0),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X="" X ^DD(399.042,.1,1,1,2.4)

 S X=DE(12),DIC=DIE

 X ^DD(399.042,.1,1,2,2.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"RC",D1,0)):^(0),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" S DIH=$G(^DGCR(399,DIV(0),"RC",DIV(1),0)),DIV=X S $P(^(0),U,15)=DIV,DIH=399.042,DIG=.15 D ^DICR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBXSC711   457     printed  Apr 09, 2024@21:20:41                                                                                                                                                                                                     Page 2

IBXSC711  ; ;08/13/09

 +1        SET X=DE(12)

           SET DIC=DIE

 +2        KILL DIV

           SET DIV=X

           SET D0=DA(1)

           SET DIV(0)=D0

           SET D1=DA

           SET DIV(1)=D1

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

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

           SET X=X

           SET DIU=X

           KILL Y

           SET X=""

           XECUTE ^DD(399.042,.1,1,1,2.4)

 +3        SET X=DE(12)

           SET DIC=DIE

 +4        XECUTE ^DD(399.042,.1,1,2,2.3)

           IF X

               SET X=DIV

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

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

               SET X=X

               SET DIU=X

               KILL Y

               SET X=""

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

               SET DIV=X

               SET $PIECE(^(0),U,15)=DIV

               SET DIH=399.042

               SET DIG=.15

               DO ^DICR