PSSJXR8 ; COMPILED XREF FOR FILE #55.06 ; 08/08/13
;
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(76)=X,PSGAL("C")=6000,PSGALFF=61 D ^PSGAL5
S X=$P($G(DIKZ(4)),U,24)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(77)=X,PSGAL("C")=6000,PSGALFF=62 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,20)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(79)=X,PSGAL("C")=6000,PSGALFF=64 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,20)
I X'="" K ^PS(55,"AUDDD",$E(X,1,30),DA(1),DA)
S DIKZ(6.5)=$G(^PS(55,DA(1),5,DA,6.5))
S X=$P($G(DIKZ(6.5)),U,1)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(78)=X,PSGAL("C")=6000,PSGALFF=65 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,21)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(80)=X,PSGAL("C")=6000,PSGALFF=66 D ^PSGAL5
S DIKZ(.1)=$G(^PS(55,DA(1),5,DA,.1))
S X=$P($G(DIKZ(.1)),U,1)
I X'="" K ^PS(55,DA(1),5,"C",$E(X,1,30),DA)
S X=$P($G(DIKZ(.1)),U,1)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(101)=X,PSGAL("C")=6000,PSGALFF=101,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(.1)),U,2)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(102)=X,PSGAL("C")=6000,PSGALFF=102,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,24)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(103)=X,PSGAL("C")=6000,PSGALFF=103,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,25)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(104)=X,PSGAL("C")=6000,PSGALFF=104,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,26)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(105)=X,PSGAL("C")=6000,PSGALFF=105,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(.1)),U,3)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(106)=X,PSGAL("C")=6000,PSGALFF=106,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,27)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(107)=X,PSGAL("C")=6000,PSGALFF=107,PSGALFN=55.06 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,1)
I X'="" I '$D(DIU(0)),'$D(PSGPO) S PSGAL(1)=X,PSGAL("C")=6000,PSGALFF=.01 D ^PSGAL5
S X=$P($G(DIKZ(0)),U,1)
I X'="" K ^PS(55,DA(1),5,"B",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I '$D(DIU(0)) K ^PS(55,"AUE",DA(1),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" K ^PS(55,"APV",DA(1),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" K ^PS(55,"ANV",DA(1),DA)
CR1 S DIXR=431
K X
S DIKZ(.2)=$G(^PS(55,DA(1),5,DA,.2))
S X(1)=$P(DIKZ(.2),U,8)
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
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. N DIKXARR M DIKXARR=X S DIKCOND=1
. S X=1
. S DIKCOND=$G(X) K X M X=DIKXARR
. Q:'DIKCOND
. K ^PS(55,"ACX",$E(X(1),1,30),$E(X(2),1,30),DA_"U")
CR2 S DIXR=434
K X
S DIKZ(2)=$G(^PS(55,DA(1),5,DA,2))
S X(1)=$P(DIKZ(2),U,2)
S X(2)=$P(DIKZ(2),U,4)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. N DIKXARR M DIKXARR=X S DIKCOND=1
. S X=$$PATCH^XPDUTL("PXRM*1.5*12")
. S DIKCOND=$G(X) K X M X=DIKXARR
. Q:'DIKCOND
. D KPSPA^PSJXRFK(.X,.DA,"UD")
CR3 S DIXR=452
K X
S DIKZ(2)=$G(^PS(55,DA(1),5,DA,2))
S X(1)=$P(DIKZ(2),U,4)
S DIKZ(8)=$G(^PS(55,DA(1),5,DA,8))
S X(2)=$P(DIKZ(8),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. K ^PS(55,"AUDC",$E(X(1),1,20),$E(X(2),1,20),DA(1),DA)
CR4 S DIXR=454
K X
S DIKZ(2)=$G(^PS(55,DA(1),5,DA,2))
S X(1)=$P(DIKZ(2),U,4)
S DIKZ(8)=$G(^PS(55,DA(1),5,DA,8))
S X(2)=$P(DIKZ(8),U,1)
S X=$G(X(1))
I $G(X(1))]"",$G(X(2))]"" D
. K X1,X2 M X1=X,X2=X
. S:$D(DIKIL) (X2,X2(1),X2(2))=""
. K ^PS(55,DA(1),5,"AUN",X(1),X(2),DA)
CR5 K X
G:'$D(DIKLM) A^PSSJXR7 Q:$D(DIKILL)
END G ^PSSJXR9
PSSJXR8 ; COMPILED XREF FOR FILE #55.06 ; 08/08/13
+1 ;
+2 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(76)=X
SET PSGAL("C")=6000
SET PSGALFF=61
DO ^PSGAL5
+3 SET X=$PIECE($GET(DIKZ(4)),U,24)
+4 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(77)=X
SET PSGAL("C")=6000
SET PSGALFF=62
DO ^PSGAL5
+5 SET X=$PIECE($GET(DIKZ(0)),U,20)
+6 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(79)=X
SET PSGAL("C")=6000
SET PSGALFF=64
DO ^PSGAL5
+7 SET X=$PIECE($GET(DIKZ(0)),U,20)
+8 IF X'=""
KILL ^PS(55,"AUDDD",$EXTRACT(X,1,30),DA(1),DA)
+9 SET DIKZ(6.5)=$GET(^PS(55,DA(1),5,DA,6.5))
+10 SET X=$PIECE($GET(DIKZ(6.5)),U,1)
+11 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(78)=X
SET PSGAL("C")=6000
SET PSGALFF=65
DO ^PSGAL5
+12 SET X=$PIECE($GET(DIKZ(0)),U,21)
+13 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(80)=X
SET PSGAL("C")=6000
SET PSGALFF=66
DO ^PSGAL5
+14 SET DIKZ(.1)=$GET(^PS(55,DA(1),5,DA,.1))
+15 SET X=$PIECE($GET(DIKZ(.1)),U,1)
+16 IF X'=""
KILL ^PS(55,DA(1),5,"C",$EXTRACT(X,1,30),DA)
+17 SET X=$PIECE($GET(DIKZ(.1)),U,1)
+18 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(101)=X
SET PSGAL("C")=6000
SET PSGALFF=101
SET PSGALFN=55.06
DO ^PSGAL5
+19 SET X=$PIECE($GET(DIKZ(.1)),U,2)
+20 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(102)=X
SET PSGAL("C")=6000
SET PSGALFF=102
SET PSGALFN=55.06
DO ^PSGAL5
+21 SET X=$PIECE($GET(DIKZ(0)),U,24)
+22 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(103)=X
SET PSGAL("C")=6000
SET PSGALFF=103
SET PSGALFN=55.06
DO ^PSGAL5
+23 SET X=$PIECE($GET(DIKZ(0)),U,25)
+24 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(104)=X
SET PSGAL("C")=6000
SET PSGALFF=104
SET PSGALFN=55.06
DO ^PSGAL5
+25 SET X=$PIECE($GET(DIKZ(0)),U,26)
+26 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(105)=X
SET PSGAL("C")=6000
SET PSGALFF=105
SET PSGALFN=55.06
DO ^PSGAL5
+27 SET X=$PIECE($GET(DIKZ(.1)),U,3)
+28 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(106)=X
SET PSGAL("C")=6000
SET PSGALFF=106
SET PSGALFN=55.06
DO ^PSGAL5
+29 SET X=$PIECE($GET(DIKZ(0)),U,27)
+30 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(107)=X
SET PSGAL("C")=6000
SET PSGALFF=107
SET PSGALFN=55.06
DO ^PSGAL5
+31 SET X=$PIECE($GET(DIKZ(0)),U,1)
+32 IF X'=""
IF '$DATA(DIU(0))
IF '$DATA(PSGPO)
SET PSGAL(1)=X
SET PSGAL("C")=6000
SET PSGALFF=.01
DO ^PSGAL5
+33 SET X=$PIECE($GET(DIKZ(0)),U,1)
+34 IF X'=""
KILL ^PS(55,DA(1),5,"B",$EXTRACT(X,1,30),DA)
+35 SET X=$PIECE($GET(DIKZ(0)),U,1)
+36 IF X'=""
IF '$DATA(DIU(0))
KILL ^PS(55,"AUE",DA(1),DA)
+37 SET X=$PIECE($GET(DIKZ(0)),U,1)
+38 IF X'=""
KILL ^PS(55,"APV",DA(1),DA)
+39 SET X=$PIECE($GET(DIKZ(0)),U,1)
+40 IF X'=""
KILL ^PS(55,"ANV",DA(1),DA)
CR1 SET DIXR=431
+1 KILL X
+2 SET DIKZ(.2)=$GET(^PS(55,DA(1),5,DA,.2))
+3 SET X(1)=$PIECE(DIKZ(.2),U,8)
+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 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+9 NEW DIKXARR
MERGE DIKXARR=X
SET DIKCOND=1
+10 SET X=1
+11 SET DIKCOND=$GET(X)
KILL X
MERGE X=DIKXARR
+12 IF 'DIKCOND
QUIT
+13 KILL ^PS(55,"ACX",$EXTRACT(X(1),1,30),$EXTRACT(X(2),1,30),DA_"U")
End DoDot:1
CR2 SET DIXR=434
+1 KILL X
+2 SET DIKZ(2)=$GET(^PS(55,DA(1),5,DA,2))
+3 SET X(1)=$PIECE(DIKZ(2),U,2)
+4 SET X(2)=$PIECE(DIKZ(2),U,4)
+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 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+9 NEW DIKXARR
MERGE DIKXARR=X
SET DIKCOND=1
+10 SET X=$$PATCH^XPDUTL("PXRM*1.5*12")
+11 SET DIKCOND=$GET(X)
KILL X
MERGE X=DIKXARR
+12 IF 'DIKCOND
QUIT
+13 DO KPSPA^PSJXRFK(.X,.DA,"UD")
End DoDot:1
CR3 SET DIXR=452
+1 KILL X
+2 SET DIKZ(2)=$GET(^PS(55,DA(1),5,DA,2))
+3 SET X(1)=$PIECE(DIKZ(2),U,4)
+4 SET DIKZ(8)=$GET(^PS(55,DA(1),5,DA,8))
+5 SET X(2)=$PIECE(DIKZ(8),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 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+10 KILL ^PS(55,"AUDC",$EXTRACT(X(1),1,20),$EXTRACT(X(2),1,20),DA(1),DA)
End DoDot:1
CR4 SET DIXR=454
+1 KILL X
+2 SET DIKZ(2)=$GET(^PS(55,DA(1),5,DA,2))
+3 SET X(1)=$PIECE(DIKZ(2),U,4)
+4 SET DIKZ(8)=$GET(^PS(55,DA(1),5,DA,8))
+5 SET X(2)=$PIECE(DIKZ(8),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 IF $DATA(DIKIL)
SET (X2,X2(1),X2(2))=""
+10 KILL ^PS(55,DA(1),5,"AUN",X(1),X(2),DA)
End DoDot:1
CR5 KILL X
+1 IF '$DATA(DIKLM)
GOTO A^PSSJXR7
IF $DATA(DIKILL)
QUIT
END GOTO ^PSSJXR9
