- 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 Apr 23, 2025@18:12:36 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
