DGPTXX9 ; COMPILED XREF FOR FILE #45 ; 10/30/24
;
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFDD^DGPTDDCR(.X,.DA,"D SD21")
CR25 S DIXR=1247
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,13)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFDD^DGPTDDCR(.X,.DA,"D SD22")
CR26 S DIXR=1248
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,14)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFDD^DGPTDDCR(.X,.DA,"D SD23")
CR27 S DIXR=1249
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,2)
S X(3)=$P(DIKZ(0),U,11)
S DIKZ(71)=$G(^DGPT(DA,71))
S X(4)=$P(DIKZ(71),U,15)
S DIKZ(70)=$G(^DGPT(DA,70))
S X(5)=$P(DIKZ(70),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
. K X1,X2 M X1=X,X2=X
. D SPTFDD^DGPTDDCR(.X,.DA,"D SD24")
CR28 S DIXR=1691
K X
S DIKZ(0)=$G(^DGPT(DA,0))
S X(1)=$P(DIKZ(0),U,1)
S X(2)=$P(DIKZ(0),U,11)
S DIKZ("401P")=$G(^DGPT(DA,"401P"))
S X(3)=$P(DIKZ("401P"),U,1)
S X(4)=$P(DIKZ("401P"),U,2)
S X(5)=$P(DIKZ("401P"),U,3)
S X(6)=$P(DIKZ("401P"),U,4)
S X(7)=$P(DIKZ("401P"),U,5)
S X=$G(X(1))
D
. K X1,X2 M X1=X,X2=X
. D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","SET")
CR29 K X
END G ^DGPTXX10
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTXX9 1706 printed Dec 13, 2024@02:54:31 Page 2
DGPTXX9 ; COMPILED XREF FOR FILE #45 ; 10/30/24
+1 ;
+2 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+3 KILL X1,X2
MERGE X1=X,X2=X
+4 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD21")
End DoDot:1
CR25 SET DIXR=1247
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,13)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD22")
End DoDot:1
CR26 SET DIXR=1248
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,14)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD23")
End DoDot:1
CR27 SET DIXR=1249
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,2)
+5 SET X(3)=$PIECE(DIKZ(0),U,11)
+6 SET DIKZ(71)=$GET(^DGPT(DA,71))
+7 SET X(4)=$PIECE(DIKZ(71),U,15)
+8 SET DIKZ(70)=$GET(^DGPT(DA,70))
+9 SET X(5)=$PIECE(DIKZ(70),U,1)
+10 SET X=$GET(X(1))
+11 IF $GET(X(1))]""
IF $GET(X(2))]""
IF $GET(X(3))]""
IF $GET(X(4))]""
Begin DoDot:1
+12 KILL X1,X2
MERGE X1=X,X2=X
+13 DO SPTFDD^DGPTDDCR(.X,.DA,"D SD24")
End DoDot:1
CR28 SET DIXR=1691
+1 KILL X
+2 SET DIKZ(0)=$GET(^DGPT(DA,0))
+3 SET X(1)=$PIECE(DIKZ(0),U,1)
+4 SET X(2)=$PIECE(DIKZ(0),U,11)
+5 SET DIKZ("401P")=$GET(^DGPT(DA,"401P"))
+6 SET X(3)=$PIECE(DIKZ("401P"),U,1)
+7 SET X(4)=$PIECE(DIKZ("401P"),U,2)
+8 SET X(5)=$PIECE(DIKZ("401P"),U,3)
+9 SET X(6)=$PIECE(DIKZ("401P"),U,4)
+10 SET X(7)=$PIECE(DIKZ("401P"),U,5)
+11 SET X=$GET(X(1))
+12 Begin DoDot:1
+13 KILL X1,X2
MERGE X1=X,X2=X
+14 DO NOTIFYP^DGPTDD(.X1,.X2,.DA,45,"DISCHARGE","SET")
End DoDot:1
CR29 KILL X
END GOTO ^DGPTXX10