- 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 Feb 19, 2025@00:20:32 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
