DVBAXA1 ; ;10/30/24
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 ---[H[J[2J[HDVBAXA1 692 printed Dec 13, 2024@01:42:30 Page 2
DVBAXA1 ; ;10/30/24
+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)