DVBHCE21 ; ;07/06/22
;;
1 N X,X1,X2 S DIXR=303 D X1(U) K X2 M X2=X D X1("F") K X1 M X1=X
K X M X=X2 D
. N DIEZCOND,DIEXARR M DIEXARR=X S DIEZCOND=1
. I '$P($G(^DPT(DA,.52)),"^",15) S X=$$CVELIG^DGCV(DA)
. S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
. N DGZ S DGZ=$S(X2(10):X2(10),1:X2(1)) D SETCV^DGCV(DA,DGZ)
Q
X1(DION) K X
S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.327,DION),$P($G(^DPT(DA,.32)),U,7))
S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.5294,DION),$P($G(^DPT(DA,.52)),U,14))
S X(3)=$G(@DIEZTMP@("V",2,DIIENS,.322021,DION),$P($G(^DPT(DA,.322)),U,21))
S X(4)=$G(@DIEZTMP@("V",2,DIIENS,.322018,DION),$P($G(^DPT(DA,.322)),U,18))
S X(5)=$G(@DIEZTMP@("V",2,DIIENS,.322012,DION),$P($G(^DPT(DA,.322)),U,12))
S X(6)=$G(@DIEZTMP@("V",2,DIIENS,.5291,DION),$P($G(^DPT(DA,.52)),U,11))
S X(7)=$G(@DIEZTMP@("V",2,DIIENS,.322019,DION),$P($G(^DPT(DA,.322)),U,19))
S X(8)=$G(@DIEZTMP@("V",2,DIIENS,.322016,DION),$P($G(^DPT(DA,.322)),U,16))
S X(9)=$G(@DIEZTMP@("V",2,DIIENS,.32201,DION),$P($G(^DPT(DA,.322)),U,10))
S X=$P($$LAST^DGMSEUTL(DA),U,2)
S:$D(X)#2 X(10)=X
S X=$G(X(1))
Q
2 N X,X1,X2 S DIXR=640 D X2(U) K X2 M X2=X D X2("F") K X1 M X1=X
D
. D KSERV^DGSRVICE(.X,.DA,"LAST")
K X M X=X2 D
. D SSERV^DGSRVICE(.X,.DA,"LAST")
Q
X2(DION) K X
S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.326,DION),$P($G(^DPT(DA,.32)),U,6))
S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.327,DION),$P($G(^DPT(DA,.32)),U,7))
S X=$G(X(1))
Q
3 N X,X1,X2 S DIXR=641 D X3(U) K X2 M X2=X D X3("F") K X1 M X1=X
D
. D KSERV^DGSRVICE(.X,.DA,"NTL")
K X M X=X2 D
. D SSERV^DGSRVICE(.X,.DA,"NTL")
Q
X3(DION) K X
S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3292,DION),$P($G(^DPT(DA,.32)),U,11))
S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.3293,DION),$P($G(^DPT(DA,.32)),U,12))
S X=$G(X(1))
Q
4 N X,X1,X2 S DIXR=642 D X4(U) K X2 M X2=X D X4("F") K X1 M X1=X
D
. D KSERV^DGSRVICE(.X,.DA,"NNTL")
K X M X=X2 D
. D SSERV^DGSRVICE(.X,.DA,"NNTL")
Q
X4(DION) K X
S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3297,DION),$P($G(^DPT(DA,.32)),U,16))
S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.3298,DION),$P($G(^DPT(DA,.32)),U,17))
S X=$G(X(1))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHCE21 2117 printed Nov 22, 2024@17:08:18 Page 2
DVBHCE21 ; ;07/06/22
+1 ;;
1 NEW X,X1,X2
SET DIXR=303
DO X1(U)
KILL X2
MERGE X2=X
DO X1("F")
KILL X1
MERGE X1=X
+1 KILL X
MERGE X=X2
Begin DoDot:1
+2 NEW DIEZCOND,DIEXARR
MERGE DIEXARR=X
SET DIEZCOND=1
+3 IF '$PIECE($GET(^DPT(DA,.52)),"^",15)
SET X=$$CVELIG^DGCV(DA)
+4 SET DIEZCOND=$GET(X)
KILL X
MERGE X=DIEXARR
if 'DIEZCOND
QUIT
+5 NEW DGZ
SET DGZ=$SELECT(X2(10):X2(10),1:X2(1))
DO SETCV^DGCV(DA,DGZ)
End DoDot:1
+6 QUIT
X1(DION) KILL X
+1 SET X(1)=$GET(@DIEZTMP@("V",2,DIIENS,.327,DION),$PIECE($GET(^DPT(DA,.32)),U,7))
+2 SET X(2)=$GET(@DIEZTMP@("V",2,DIIENS,.5294,DION),$PIECE($GET(^DPT(DA,.52)),U,14))
+3 SET X(3)=$GET(@DIEZTMP@("V",2,DIIENS,.322021,DION),$PIECE($GET(^DPT(DA,.322)),U,21))
+4 SET X(4)=$GET(@DIEZTMP@("V",2,DIIENS,.322018,DION),$PIECE($GET(^DPT(DA,.322)),U,18))
+5 SET X(5)=$GET(@DIEZTMP@("V",2,DIIENS,.322012,DION),$PIECE($GET(^DPT(DA,.322)),U,12))
+6 SET X(6)=$GET(@DIEZTMP@("V",2,DIIENS,.5291,DION),$PIECE($GET(^DPT(DA,.52)),U,11))
+7 SET X(7)=$GET(@DIEZTMP@("V",2,DIIENS,.322019,DION),$PIECE($GET(^DPT(DA,.322)),U,19))
+8 SET X(8)=$GET(@DIEZTMP@("V",2,DIIENS,.322016,DION),$PIECE($GET(^DPT(DA,.322)),U,16))
+9 SET X(9)=$GET(@DIEZTMP@("V",2,DIIENS,.32201,DION),$PIECE($GET(^DPT(DA,.322)),U,10))
+10 SET X=$PIECE($$LAST^DGMSEUTL(DA),U,2)
+11 if $DATA(X)#2
SET X(10)=X
+12 SET X=$GET(X(1))
+13 QUIT
2 NEW X,X1,X2
SET DIXR=640
DO X2(U)
KILL X2
MERGE X2=X
DO X2("F")
KILL X1
MERGE X1=X
+1 Begin DoDot:1
+2 DO KSERV^DGSRVICE(.X,.DA,"LAST")
End DoDot:1
+3 KILL X
MERGE X=X2
Begin DoDot:1
+4 DO SSERV^DGSRVICE(.X,.DA,"LAST")
End DoDot:1
+5 QUIT
X2(DION) KILL X
+1 SET X(1)=$GET(@DIEZTMP@("V",2,DIIENS,.326,DION),$PIECE($GET(^DPT(DA,.32)),U,6))
+2 SET X(2)=$GET(@DIEZTMP@("V",2,DIIENS,.327,DION),$PIECE($GET(^DPT(DA,.32)),U,7))
+3 SET X=$GET(X(1))
+4 QUIT
3 NEW X,X1,X2
SET DIXR=641
DO X3(U)
KILL X2
MERGE X2=X
DO X3("F")
KILL X1
MERGE X1=X
+1 Begin DoDot:1
+2 DO KSERV^DGSRVICE(.X,.DA,"NTL")
End DoDot:1
+3 KILL X
MERGE X=X2
Begin DoDot:1
+4 DO SSERV^DGSRVICE(.X,.DA,"NTL")
End DoDot:1
+5 QUIT
X3(DION) KILL X
+1 SET X(1)=$GET(@DIEZTMP@("V",2,DIIENS,.3292,DION),$PIECE($GET(^DPT(DA,.32)),U,11))
+2 SET X(2)=$GET(@DIEZTMP@("V",2,DIIENS,.3293,DION),$PIECE($GET(^DPT(DA,.32)),U,12))
+3 SET X=$GET(X(1))
+4 QUIT
4 NEW X,X1,X2
SET DIXR=642
DO X4(U)
KILL X2
MERGE X2=X
DO X4("F")
KILL X1
MERGE X1=X
+1 Begin DoDot:1
+2 DO KSERV^DGSRVICE(.X,.DA,"NNTL")
End DoDot:1
+3 KILL X
MERGE X=X2
Begin DoDot:1
+4 DO SSERV^DGSRVICE(.X,.DA,"NNTL")
End DoDot:1
+5 QUIT
X4(DION) KILL X
+1 SET X(1)=$GET(@DIEZTMP@("V",2,DIIENS,.3297,DION),$PIECE($GET(^DPT(DA,.32)),U,16))
+2 SET X(2)=$GET(@DIEZTMP@("V",2,DIIENS,.3298,DION),$PIECE($GET(^DPT(DA,.32)),U,17))
+3 SET X=$GET(X(1))
+4 QUIT
