DVBAXA1.m

DVBAXA1 ; ;12/08/20

 S X=DG(DQ),DIC=DIE

 X ^DD(2,.525,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$S('$D(^DIC(22,+$P(Y(1),U,6),0)):"",1:$P(^(0),U,1)) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,1,1.4)

 S X=DG(DQ),DIC=DIE

 X ^DD(2,.525,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$P(Y(1),U,7) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,2,1.4)

 S X=DG(DQ),DIC=DIE

 X ^DD(2,.525,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$P(Y(1),U,8) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,3,1.4)

 S X=DG(DQ),DIC=DIE

 D AUTOUPD^DGENA2(DA)

 S X=DG(DQ),DIC=DIE

 X "S DFN=DA D EN^DGMTR K DGREQF"

 S X=DG(DQ),DIC=DIE

 D EVENT^IVMPLOG(DA)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBAXA1   692     printed  Apr 09, 2024@20:44:38                                                                                                                                                                                                      Page 2

DVBAXA1   ; ;12/08/20

 +1        SET X=DG(DQ)

           SET DIC=DIE

 +2        XECUTE ^DD(2,.525,1,1,1.3)

           IF X

               SET X=DIV

               SET Y(1)=$SELECT($DATA(^DPT(D0,.52)):^(.52),1:"")

               SET X=$SELECT('$DATA(^DIC(22,+$PIECE(Y(1),U,6),0)):"",1:$PIECE(^(0),U,1))

               SET DIU=X

               KILL Y

               SET X=DIV

               SET X=""

               XECUTE ^DD(2,.525,1,1,1.4)

 +3        SET X=DG(DQ)

           SET DIC=DIE

 +4        XECUTE ^DD(2,.525,1,2,1.3)

           IF X

               SET X=DIV

               SET Y(1)=$SELECT($DATA(^DPT(D0,.52)):^(.52),1:"")

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

               SET DIU=X

               KILL Y

               SET X=DIV

               SET X=""

               XECUTE ^DD(2,.525,1,2,1.4)

 +5        SET X=DG(DQ)

           SET DIC=DIE

 +6        XECUTE ^DD(2,.525,1,3,1.3)

           IF X

               SET X=DIV

               SET Y(1)=$SELECT($DATA(^DPT(D0,.52)):^(.52),1:"")

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

               SET DIU=X

               KILL Y

               SET X=DIV

               SET X=""

               XECUTE ^DD(2,.525,1,3,1.4)

 +7        SET X=DG(DQ)

           SET DIC=DIE

 +8        DO AUTOUPD^DGENA2(DA)

 +9        SET X=DG(DQ)

           SET DIC=DIE

 +10       XECUTE "S DFN=DA D EN^DGMTR K DGREQF"

 +11       SET X=DG(DQ)

           SET DIC=DIE

 +12       DO EVENT^IVMPLOG(DA)