- DGPTXX12 ; COMPILED XREF FOR FILE #45.05 ; 10/30/24
- ;
- S DA=0
- A1 ;
- I $D(DISET) K DIKLM S:DIKM1=1 DIKLM=1 G @DIKM1
- 0 ;
- A S DA=$O(^DGPT(DA(1),"P",DA)) I DA'>0 S DA=0 G END
- 1 ;
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X=$P($G(DIKZ(0)),U,5)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,6)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,7)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,8)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,9)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,10)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,11)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,12)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,13)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,14)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,15)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,16)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,17)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,18)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,19)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,20)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,21)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,22)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,23)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(0)),U,24)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))
- S X=$P($G(DIKZ(1)),U,1)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(1)),U,2)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(1)),U,3)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(1)),U,4)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- S X=$P($G(DIKZ(1)),U,5)
- I X'="" S ^DGPT(DA(1),"P","AP6",$E(X,1,30),DA)=""
- CR1 S DIXR=1200
- K X
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,5)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",1)
- CR2 S DIXR=1201
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,6)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",2)
- CR3 S DIXR=1202
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,7)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",3)
- CR4 S DIXR=1203
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,8)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",4)
- CR5 S DIXR=1204
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,9)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",5)
- CR6 S DIXR=1250
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,14)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",10)
- CR7 S DIXR=1251
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,15)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",11)
- CR8 S DIXR=1252
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,16)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",12)
- CR9 S DIXR=1253
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,17)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",13)
- CR10 S DIXR=1254
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,18)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",14)
- CR11 S DIXR=1255
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,19)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",15)
- CR12 S DIXR=1256
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,20)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",16)
- CR13 S DIXR=1257
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,21)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",17)
- CR14 S DIXR=1258
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,22)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",18)
- CR15 S DIXR=1259
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,23)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",19)
- CR16 S DIXR=1260
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,24)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",20)
- CR17 S DIXR=1261
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))
- S X(2)=$P(DIKZ(1),U,1)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",21)
- CR18 S DIXR=1262
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))
- S X(2)=$P(DIKZ(1),U,2)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",22)
- CR19 S DIXR=1263
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))
- S X(2)=$P(DIKZ(1),U,3)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",23)
- CR20 S DIXR=1264
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))
- S X(2)=$P(DIKZ(1),U,4)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",24)
- CR21 S DIXR=1265
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S DIKZ(1)=$G(^DGPT(DA(1),"P",DA,1))
- S X(2)=$P(DIKZ(1),U,5)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",25)
- CR22 S DIXR=1266
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,10)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",6)
- CR23 S DIXR=1267
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,11)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",7)
- CR24 S DIXR=1268
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,12)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",8)
- CR25 S DIXR=1269
- K X
- S DIKZ(0)=$G(^DGPT(DA(1),"P",DA,0))
- S X(1)=$P(DIKZ(0),U,1)
- S X(2)=$P(DIKZ(0),U,13)
- S X=$G(X(1))
- I $G(X(1))]"",$G(X(2))]"" D
- . K X1,X2 M X1=X,X2=X
- . D SPTFP^DGPTDDCR(.X,.DA,"P",9)
- CR26 K X
- G:'$D(DIKLM) A Q:$D(DISET)
- END G ^DGPTXX13
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTXX12 7856 printed Feb 19, 2025@00:20:23 Page 2
- DGPTXX12 ; COMPILED XREF FOR FILE #45.05 ; 10/30/24
- +1 ;
- +2 SET DA=0
- A1 ;
- +1 IF $DATA(DISET)
- KILL DIKLM
- if DIKM1=1
- SET DIKLM=1
- GOTO @DIKM1
- 0 ;
- A SET DA=$ORDER(^DGPT(DA(1),"P",DA))
- IF DA'>0
- SET DA=0
- GOTO END
- 1 ;
- +1 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +2 SET X=$PIECE($GET(DIKZ(0)),U,5)
- +3 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +4 SET X=$PIECE($GET(DIKZ(0)),U,6)
- +5 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +6 SET X=$PIECE($GET(DIKZ(0)),U,7)
- +7 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +8 SET X=$PIECE($GET(DIKZ(0)),U,8)
- +9 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +10 SET X=$PIECE($GET(DIKZ(0)),U,9)
- +11 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +12 SET X=$PIECE($GET(DIKZ(0)),U,10)
- +13 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +14 SET X=$PIECE($GET(DIKZ(0)),U,11)
- +15 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +16 SET X=$PIECE($GET(DIKZ(0)),U,12)
- +17 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +18 SET X=$PIECE($GET(DIKZ(0)),U,13)
- +19 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +20 SET X=$PIECE($GET(DIKZ(0)),U,14)
- +21 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +22 SET X=$PIECE($GET(DIKZ(0)),U,15)
- +23 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +24 SET X=$PIECE($GET(DIKZ(0)),U,16)
- +25 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +26 SET X=$PIECE($GET(DIKZ(0)),U,17)
- +27 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +28 SET X=$PIECE($GET(DIKZ(0)),U,18)
- +29 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +30 SET X=$PIECE($GET(DIKZ(0)),U,19)
- +31 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +32 SET X=$PIECE($GET(DIKZ(0)),U,20)
- +33 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +34 SET X=$PIECE($GET(DIKZ(0)),U,21)
- +35 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +36 SET X=$PIECE($GET(DIKZ(0)),U,22)
- +37 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +38 SET X=$PIECE($GET(DIKZ(0)),U,23)
- +39 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +40 SET X=$PIECE($GET(DIKZ(0)),U,24)
- +41 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +42 SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))
- +43 SET X=$PIECE($GET(DIKZ(1)),U,1)
- +44 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +45 SET X=$PIECE($GET(DIKZ(1)),U,2)
- +46 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +47 SET X=$PIECE($GET(DIKZ(1)),U,3)
- +48 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +49 SET X=$PIECE($GET(DIKZ(1)),U,4)
- +50 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- +51 SET X=$PIECE($GET(DIKZ(1)),U,5)
- +52 IF X'=""
- SET ^DGPT(DA(1),"P","AP6",$EXTRACT(X,1,30),DA)=""
- CR1 SET DIXR=1200
- +1 KILL X
- +2 SET X(1)=$PIECE(DIKZ(0),U,1)
- +3 SET X(2)=$PIECE(DIKZ(0),U,5)
- +4 SET X=$GET(X(1))
- +5 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +6 KILL X1,X2
- MERGE X1=X,X2=X
- +7 DO SPTFP^DGPTDDCR(.X,.DA,"P",1)
- End DoDot:1
- CR2 SET DIXR=1201
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,6)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",2)
- End DoDot:1
- CR3 SET DIXR=1202
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,7)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",3)
- End DoDot:1
- CR4 SET DIXR=1203
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,8)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",4)
- End DoDot:1
- CR5 SET DIXR=1204
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,9)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",5)
- End DoDot:1
- CR6 SET DIXR=1250
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,14)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",10)
- End DoDot:1
- CR7 SET DIXR=1251
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,15)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",11)
- End DoDot:1
- CR8 SET DIXR=1252
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,16)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",12)
- End DoDot:1
- CR9 SET DIXR=1253
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,17)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",13)
- End DoDot:1
- CR10 SET DIXR=1254
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,18)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",14)
- End DoDot:1
- CR11 SET DIXR=1255
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,19)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",15)
- End DoDot:1
- CR12 SET DIXR=1256
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,20)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",16)
- End DoDot:1
- CR13 SET DIXR=1257
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,21)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",17)
- End DoDot:1
- CR14 SET DIXR=1258
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,22)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",18)
- End DoDot:1
- CR15 SET DIXR=1259
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,23)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",19)
- End DoDot:1
- CR16 SET DIXR=1260
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,24)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",20)
- End DoDot:1
- CR17 SET DIXR=1261
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))
- +5 SET X(2)=$PIECE(DIKZ(1),U,1)
- +6 SET X=$GET(X(1))
- +7 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +8 KILL X1,X2
- MERGE X1=X,X2=X
- +9 DO SPTFP^DGPTDDCR(.X,.DA,"P",21)
- End DoDot:1
- CR18 SET DIXR=1262
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))
- +5 SET X(2)=$PIECE(DIKZ(1),U,2)
- +6 SET X=$GET(X(1))
- +7 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +8 KILL X1,X2
- MERGE X1=X,X2=X
- +9 DO SPTFP^DGPTDDCR(.X,.DA,"P",22)
- End DoDot:1
- CR19 SET DIXR=1263
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))
- +5 SET X(2)=$PIECE(DIKZ(1),U,3)
- +6 SET X=$GET(X(1))
- +7 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +8 KILL X1,X2
- MERGE X1=X,X2=X
- +9 DO SPTFP^DGPTDDCR(.X,.DA,"P",23)
- End DoDot:1
- CR20 SET DIXR=1264
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))
- +5 SET X(2)=$PIECE(DIKZ(1),U,4)
- +6 SET X=$GET(X(1))
- +7 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +8 KILL X1,X2
- MERGE X1=X,X2=X
- +9 DO SPTFP^DGPTDDCR(.X,.DA,"P",24)
- End DoDot:1
- CR21 SET DIXR=1265
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET DIKZ(1)=$GET(^DGPT(DA(1),"P",DA,1))
- +5 SET X(2)=$PIECE(DIKZ(1),U,5)
- +6 SET X=$GET(X(1))
- +7 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +8 KILL X1,X2
- MERGE X1=X,X2=X
- +9 DO SPTFP^DGPTDDCR(.X,.DA,"P",25)
- End DoDot:1
- CR22 SET DIXR=1266
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,10)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",6)
- End DoDot:1
- CR23 SET DIXR=1267
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,11)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",7)
- End DoDot:1
- CR24 SET DIXR=1268
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,12)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",8)
- End DoDot:1
- CR25 SET DIXR=1269
- +1 KILL X
- +2 SET DIKZ(0)=$GET(^DGPT(DA(1),"P",DA,0))
- +3 SET X(1)=$PIECE(DIKZ(0),U,1)
- +4 SET X(2)=$PIECE(DIKZ(0),U,13)
- +5 SET X=$GET(X(1))
- +6 IF $GET(X(1))]""
- IF $GET(X(2))]""
- Begin DoDot:1
- +7 KILL X1,X2
- MERGE X1=X,X2=X
- +8 DO SPTFP^DGPTDDCR(.X,.DA,"P",9)
- End DoDot:1
- CR26 KILL X
- +1 if '$DATA(DIKLM)
- GOTO A
- if $DATA(DISET)
- QUIT
- END GOTO ^DGPTXX13