Home Package List Routine Alphabetical List Global Alphabetical List FileMan Files List FileMan Sub-Files List Package Component Lists Package-Namespace Mapping
Routine: IBXSC66

IBXSC66.m

Go to the documentation of this file.

IBXSC66 ; ;08/13/09

 S X=DG(DQ),DIC=DIE

 X ^DD(399,161,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV D DIS^IBCU S X=X S DIH=$G(^DGCR(399,DIV(0),"U")),DIV=X S $P(^("U"),U,12)=DIV,DIH=399,DIG=162 D ^DICR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBXSC66   267     printed  Sep 02, 2024@19:17:24                                                                                                                                                                                                      Page 2

IBXSC66   ; ;08/13/09

 +1        SET X=DG(DQ)

           SET DIC=DIE

 +2        XECUTE ^DD(399,161,1,1,1.3)

           IF X

               SET X=DIV

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

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

               SET X=X

               SET DIU=X

               KILL Y

               SET X=DIV

               DO DIS^IBCU

               SET X=X

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

               SET DIV=X

               SET $PIECE(^("U"),U,12)=DIV

               SET DIH=399

               SET DIG=162

               DO ^DICR