DVBAXA20 ; ;10/30/24
 S X=DG(DQ),DIC=DIE
 D EVENT^IVMPLOG(DA)
 S X=DG(DQ),DIC=DIE
 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.132)):^(.132),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X=DIV S X=$G(DUZ) S DIH=$G(^DPT(DIV(0),.132)),DIV=X S $P(^(.132),U,5)=DIV,DIH=2,DIG=.1325 D ^DICR
 S X=DG(DQ),DIC=DIE
 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.132)):^(.132),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.132)),DIV=X S $P(^(.132),U,6)=DIV,DIH=2,DIG=.1326 D ^DICR
 S X=DG(DQ),DIC=DIE
 ;
 S X=DG(DQ),DIC=DIE
 ;
 S X=DG(DQ),DIC=DIE
 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
 S X=DG(DQ),DIC=DIE
 I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".132;" D AVAFC^VAFCDD01(DA)
 S X=DG(DQ),DIC=DIE
 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
 I $D(DE(24))'[0!($G(^DD(DP,DIFLD,"AUDIT"))["y") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAXA20   916     printed  Sep 23, 2025@19:18:40                                                                                                                                                                                                     Page 2
DVBAXA20  ; ;10/30/24
 +1        SET X=DG(DQ)
           SET DIC=DIE
 +2        DO EVENT^IVMPLOG(DA)
 +3        SET X=DG(DQ)
           SET DIC=DIE
 +4        KILL DIV
           SET DIV=X
           SET D0=DA
           SET DIV(0)=D0
           SET Y(1)=$SELECT($DATA(^DPT(D0,.132)):^(.132),1:"")
           SET X=$PIECE(Y(1),U,5)
           SET X=X
           SET DIU=X
           KILL Y
           SET X=DIV
           SET X=$GET(DUZ)
           SET DIH=$GET(^DPT(DIV(0),.132))
           SET DIV=X
           SET $PIECE(^(.132),U,5)=DIV
           SET DIH=2
           SET DIG=.1325
           DO ^DICR
 +5        SET X=DG(DQ)
           SET DIC=DIE
 +6        KILL DIV
           SET DIV=X
           SET D0=DA
           SET DIV(0)=D0
           SET Y(1)=$SELECT($DATA(^DPT(D0,.132)):^(.132),1:"")
           SET X=$PIECE(Y(1),U,6)
           SET X=X
           SET DIU=X
           KILL Y
           SET X=DIV
           SET X=$$NOW^XLFDT()
           SET DIH=$GET(^DPT(DIV(0),.132))
           SET DIV=X
           SET $PIECE(^(.132),U,6)=DIV
           SET DIH=2
           SET DIG=.1326
           DO ^DICR
 +7        SET X=DG(DQ)
           SET DIC=DIE
 +8       ;
 +9        SET X=DG(DQ)
           SET DIC=DIE
 +10      ;
 +11       SET X=DG(DQ)
           SET DIC=DIE
 +12       SET IVMX=X
           SET X="IVMPXFR"
           XECUTE ^%ZOSF("TEST")
           if $TEST
               DO DPT^IVMPXFR
           SET X=IVMX
           KILL IVMX
 +13       SET X=DG(DQ)
           SET DIC=DIE
 +14       IF ($TEXT(AVAFC^VAFCDD01)'="")
               SET VAFCF=".132;"
               DO AVAFC^VAFCDD01(DA)
 +15       SET X=DG(DQ)
           SET DIC=DIE
 +16       if ($TEXT(ADGRU^DGRUDD01)'="")
               DO ADGRU^DGRUDD01(DA)
 +17       IF $DATA(DE(24))'[0!($GET(^DD(DP,DIFLD,"AUDIT"))["y")
               SET X=DG(DQ)
               SET DIIX=3_U_DIFLD
               DO AUDIT^DIET