IBXSAH8.m

IBXSAH8 ; ;11/02/18

 S X=DG(DQ),DIC=DIE

 S ^DGCR(399,DA(1),"PRV","B",$E(X,1,30),DA)=""

 S X=DG(DQ),DIC=DIE

 K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(0)=X S X=Y(0),X=X S X=X'=1 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"PRV",D1,0)):^(0),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(399.0222,.01,1,2,1.4)

 S X=DG(DQ),DIC=DIE

 S ^DGCR(399,DA(1),"PRV","C",$E($$EXTERNAL^DILFD(399.0222,.01,,X),1,30),DA)=""

 S X=DG(DQ),DIC=DIE

 S ^DGCR(399,DA(1),"PRV","C",$$LOW^XLFSTR($E($$EXTERNAL^DILFD(399.0222,.01,,X),1,30)),DA)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBXSAH8   539     printed  Apr 09, 2024@21:26                                                                                                                                                                                                         Page 2

IBXSAH8   ; ;11/02/18

 +1        SET X=DG(DQ)

           SET DIC=DIE

 +2        SET ^DGCR(399,DA(1),"PRV","B",$EXTRACT(X,1,30),DA)=""

 +3        SET X=DG(DQ)

           SET DIC=DIE

 +4        KILL DIV

           SET DIV=X

           SET D0=DA(1)

           SET DIV(0)=D0

           SET D1=DA

           SET DIV(1)=D1

           SET Y(0)=X

           SET X=Y(0)

           SET X=X

           SET X=X'=1

           IF X

               SET X=DIV

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

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

               SET X=X

               SET DIU=X

               KILL Y

               SET X=""

               XECUTE ^DD(399.0222,.01,1,2,1.4)

 +5        SET X=DG(DQ)

           SET DIC=DIE

 +6        SET ^DGCR(399,DA(1),"PRV","C",$EXTRACT($$EXTERNAL^DILFD(399.0222,.01,,X),1,30),DA)=""

 +7        SET X=DG(DQ)

           SET DIC=DIE

 +8        SET ^DGCR(399,DA(1),"PRV","C",$$LOW^XLFSTR($EXTRACT($$EXTERNAL^DILFD(399.0222,.01,,X),1,30)),DA)=""