- 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 Jan 18, 2025@02:43:44 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)