PSJXR515 ; COMPILED XREF FOR FILE #55.06 ; 10/28/97
;
I X'="" S ^PS(55,DA(1),5,"AUS",+X,DA)="" I $P($G(^PS(55,DA(1),5,DA,0)),"^",7)]"" S ^PS(55,DA(1),5,"AU",$P(^(0),"^",7),+X,DA)=""
S X=$P(DIKZ(2),U,4)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(53))#2 KILL^PSGAL5:PSGAL(53)=X K PSGAL
S X=$P(DIKZ(2),U,4)
I X'="" S ^PS(55,"AUD",$E(X,1,30),DA(1),DA)=""
S X=$P(DIKZ(5),U,4)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(61))#2 KILL^PSGAL5:PSGAL(61)=X K PSGAL
S X=$P(DIKZ(5),U,3)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(54))#2 KILL^PSGAL5:PSGAL(54)=X K PSGAL
S X=$P(DIKZ(5),U,5)
I X'="" D
.N DIK,DIV,DIU,DIN
.I X S DIU=$S($D(^PS(55,DA(1),5,DA,5)):$P(^(5),"^",4),1:""),$P(^(5),"^",4)=DIU+X I $O(^DD(55.06,35,1,0)) K DIV S (DIV(0),D0)=DA(1),(DIV(1),D1)=DA,DIV=DIU+X,DIH=55.06,DIG=35 D ^DICR
S X=$P(DIKZ(5),U,5)
I X'="" ; I X S PSGAMSF=2 D ^PSGAMSA
S X=$P(DIKZ(2),U,5)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(56))#2 KILL^PSGAL5:PSGAL(56)=X K PSGAL
S X=$P(DIKZ(2),U,5)
I X'="" I $P($G(^PS(55,DA(1),5,DA,2)),"^")["@" S $P(^(2),"^")=$P($P(^(2),"^"),"@")_"@"_X
S X=$P(DIKZ(2),U,6)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(57))#2 KILL^PSGAL5:PSGAL(57)=X K PSGAL
S X=$P(DIKZ(4),U,15)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(58)) KILL^PSGAL5:PSGAL(58)=X K PSGAL
S X=$P(DIKZ(4),U,16)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(59))#2 KILL^PSGAL5:PSGAL(59)=X K PSGAL
S X=$P(DIKZ(4),U,17)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(60))#2 KILL^PSGAL5:PSGAL(60)=X K PSGAL
S X=$P(DIKZ(4),U,12)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(63)) KILL^PSGAL5:PSGAL(63)=X K PSGAL
S X=$P(DIKZ(4),U,13)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(64)) KILL^PSGAL5:PSGAL(64)=X K PSGAL
S X=$P(DIKZ(4),U,14)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(65)) KILL^PSGAL5:PSGAL(65)=X K PSGAL
S X=$P(DIKZ(4),U,11)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(62))#2 KILL^PSGAL5:PSGAL(62)=X K PSGAL
S X=$P(DIKZ(4),U,9)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(66)) KILL^PSGAL5:PSGAL(66)=X K PSGAL
S X=$P(DIKZ(4),U,10)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(67)) KILL^PSGAL5:PSGAL(67)=X K PSGAL
S DIKZ(7)=$G(^PS(55,DA(1),5,DA,7))
S X=$P(DIKZ(7),U,1)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(68)) KILL^PSGAL5:PSGAL(68)=X K PSGAL
S X=$P(DIKZ(7),U,2)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(69)) KILL^PSGAL5:PSGAL(69)=X K PSGAL
S X=$P(DIKZ(5),U,7)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(70)) KILL^PSGAL5:PSGAL(70)=X K PSGAL
S X=$P(DIKZ(5),U,8)
I X'="" D
.N DIK,DIV,DIU,DIN
.I X S DIU=$S($D(^PS(55,DA(1),5,DA,5)):$P(^(5),"^",7),1:""),$P(^(5),"^",7)=DIU+X I $O(^DD(55.06,54,1,0)) K DIV S (DIV(0),D0)=DA(1),(DIV(1),D1)=DA,DIV=DIU+X,DIH=55.06,DIG=54 D ^DICR
S X=$P(DIKZ(5),U,8)
I X'="" ; I '$D(DIU(0)),X S PSGAMSF=0 D ^PSGAMSA
S X=$P(DIKZ(4),U,18)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(71)) KILL^PSGAL5:PSGAL(71)=X K PSGAL
S X=$P(DIKZ(4),U,19)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(72)) KILL^PSGAL5:PSGAL(72)=X K PSGAL
S X=$P(DIKZ(4),U,20)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(73)) KILL^PSGAL5:PSGAL(73)=X K PSGAL
S X=$P(DIKZ(4),U,21)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(74)) KILL^PSGAL5:PSGAL(74)=X K PSGAL
S X=$P(DIKZ(4),U,22)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(75)) KILL^PSGAL5:PSGAL(75)=X K PSGAL
S X=$P(DIKZ(4),U,23)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(76)) KILL^PSGAL5:PSGAL(76)=X K PSGAL
S X=$P(DIKZ(4),U,24)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(77)) KILL^PSGAL5:PSGAL(77)=X K PSGAL
S X=$P(DIKZ(0),U,20)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(79)) KILL^PSGAL5:PSGAL(79)=X K PSGAL
S X=$P(DIKZ(0),U,20)
I X'="" S ^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(DIKZ(6.5),U,1)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(78)) KILL^PSGAL5:PSGAL(78)=X K PSGAL
S X=$P(DIKZ(0),U,21)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(80)) KILL^PSGAL5:PSGAL(80)=X K PSGAL
S DIKZ(.1)=$G(^PS(55,DA(1),5,DA,.1))
S X=$P(DIKZ(.1),U,1)
I X'="" S ^PS(55,DA(1),5,"C",$E(X,1,30),DA)=""
S X=$P(DIKZ(.1),U,1)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(101)) KILL^PSGAL5:PSGAL(101)=X K PSGAL
S X=$P(DIKZ(.1),U,2)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(102)) KILL^PSGAL5:PSGAL(102)=X K PSGAL
S X=$P(DIKZ(0),U,24)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(103)) KILL^PSGAL5:PSGAL(103)=X K PSGAL
S X=$P(DIKZ(0),U,25)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(104)) KILL^PSGAL5:PSGAL(104)=X K PSGAL
S X=$P(DIKZ(0),U,26)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(105)) KILL^PSGAL5:PSGAL(105)=X K PSGAL
S X=$P(DIKZ(.1),U,3)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(106)) KILL^PSGAL5:PSGAL(106)=X K PSGAL
S X=$P(DIKZ(0),U,27)
I X'="" I '$D(DIU(0)) D:$D(PSGAL(107)) KILL^PSGAL5:PSGAL(107)=X K PSGAL
G:'$D(DIKLM) A^PSJXR514 Q:$D(DISET)
END G ^PSJXR516
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJXR515 4552 printed Oct 16, 2024@18:10:10 Page 2
PSJXR515 ; COMPILED XREF FOR FILE #55.06 ; 10/28/97
+1 ;
+2 IF X'=""
SET ^PS(55,DA(1),5,"AUS",+X,DA)=""
IF $PIECE($GET(^PS(55,DA(1),5,DA,0)),"^",7)]""
SET ^PS(55,DA(1),5,"AU",$PIECE(^(0),"^",7),+X,DA)=""
+3 SET X=$PIECE(DIKZ(2),U,4)
+4 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(53))#2
if PSGAL(53)=X
DO KILL^PSGAL5
KILL PSGAL
+5 SET X=$PIECE(DIKZ(2),U,4)
+6 IF X'=""
SET ^PS(55,"AUD",$EXTRACT(X,1,30),DA(1),DA)=""
+7 SET X=$PIECE(DIKZ(5),U,4)
+8 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(61))#2
if PSGAL(61)=X
DO KILL^PSGAL5
KILL PSGAL
+9 SET X=$PIECE(DIKZ(5),U,3)
+10 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(54))#2
if PSGAL(54)=X
DO KILL^PSGAL5
KILL PSGAL
+11 SET X=$PIECE(DIKZ(5),U,5)
+12 IF X'=""
Begin DoDot:1
+13 NEW DIK,DIV,DIU,DIN
+14 IF X
SET DIU=$SELECT($DATA(^PS(55,DA(1),5,DA,5)):$PIECE(^(5),"^",4),1:"")
SET $PIECE(^(5),"^",4)=DIU+X
IF $ORDER(^DD(55.06,35,1,0))
KILL DIV
SET (DIV(0),D0)=DA(1)
SET (DIV(1),D1)=DA
SET DIV=DIU+X
SET DIH=55.06
SET DIG=35
DO ^DICR
End DoDot:1
+15 SET X=$PIECE(DIKZ(5),U,5)
+16 ; I X S PSGAMSF=2 D ^PSGAMSA
IF X'=""
+17 SET X=$PIECE(DIKZ(2),U,5)
+18 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(56))#2
if PSGAL(56)=X
DO KILL^PSGAL5
KILL PSGAL
+19 SET X=$PIECE(DIKZ(2),U,5)
+20 IF X'=""
IF $PIECE($GET(^PS(55,DA(1),5,DA,2)),"^")["@"
SET $PIECE(^(2),"^")=$PIECE($PIECE(^(2),"^"),"@")_"@"_X
+21 SET X=$PIECE(DIKZ(2),U,6)
+22 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(57))#2
if PSGAL(57)=X
DO KILL^PSGAL5
KILL PSGAL
+23 SET X=$PIECE(DIKZ(4),U,15)
+24 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(58))
if PSGAL(58)=X
DO KILL^PSGAL5
KILL PSGAL
+25 SET X=$PIECE(DIKZ(4),U,16)
+26 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(59))#2
if PSGAL(59)=X
DO KILL^PSGAL5
KILL PSGAL
+27 SET X=$PIECE(DIKZ(4),U,17)
+28 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(60))#2
if PSGAL(60)=X
DO KILL^PSGAL5
KILL PSGAL
+29 SET X=$PIECE(DIKZ(4),U,12)
+30 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(63))
if PSGAL(63)=X
DO KILL^PSGAL5
KILL PSGAL
+31 SET X=$PIECE(DIKZ(4),U,13)
+32 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(64))
if PSGAL(64)=X
DO KILL^PSGAL5
KILL PSGAL
+33 SET X=$PIECE(DIKZ(4),U,14)
+34 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(65))
if PSGAL(65)=X
DO KILL^PSGAL5
KILL PSGAL
+35 SET X=$PIECE(DIKZ(4),U,11)
+36 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(62))#2
if PSGAL(62)=X
DO KILL^PSGAL5
KILL PSGAL
+37 SET X=$PIECE(DIKZ(4),U,9)
+38 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(66))
if PSGAL(66)=X
DO KILL^PSGAL5
KILL PSGAL
+39 SET X=$PIECE(DIKZ(4),U,10)
+40 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(67))
if PSGAL(67)=X
DO KILL^PSGAL5
KILL PSGAL
+41 SET DIKZ(7)=$GET(^PS(55,DA(1),5,DA,7))
+42 SET X=$PIECE(DIKZ(7),U,1)
+43 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(68))
if PSGAL(68)=X
DO KILL^PSGAL5
KILL PSGAL
+44 SET X=$PIECE(DIKZ(7),U,2)
+45 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(69))
if PSGAL(69)=X
DO KILL^PSGAL5
KILL PSGAL
+46 SET X=$PIECE(DIKZ(5),U,7)
+47 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(70))
if PSGAL(70)=X
DO KILL^PSGAL5
KILL PSGAL
+48 SET X=$PIECE(DIKZ(5),U,8)
+49 IF X'=""
Begin DoDot:1
+50 NEW DIK,DIV,DIU,DIN
+51 IF X
SET DIU=$SELECT($DATA(^PS(55,DA(1),5,DA,5)):$PIECE(^(5),"^",7),1:"")
SET $PIECE(^(5),"^",7)=DIU+X
IF $ORDER(^DD(55.06,54,1,0))
KILL DIV
SET (DIV(0),D0)=DA(1)
SET (DIV(1),D1)=DA
SET DIV=DIU+X
SET DIH=55.06
SET DIG=54
DO ^DICR
End DoDot:1
+52 SET X=$PIECE(DIKZ(5),U,8)
+53 ; I '$D(DIU(0)),X S PSGAMSF=0 D ^PSGAMSA
IF X'=""
+54 SET X=$PIECE(DIKZ(4),U,18)
+55 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(71))
if PSGAL(71)=X
DO KILL^PSGAL5
KILL PSGAL
+56 SET X=$PIECE(DIKZ(4),U,19)
+57 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(72))
if PSGAL(72)=X
DO KILL^PSGAL5
KILL PSGAL
+58 SET X=$PIECE(DIKZ(4),U,20)
+59 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(73))
if PSGAL(73)=X
DO KILL^PSGAL5
KILL PSGAL
+60 SET X=$PIECE(DIKZ(4),U,21)
+61 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(74))
if PSGAL(74)=X
DO KILL^PSGAL5
KILL PSGAL
+62 SET X=$PIECE(DIKZ(4),U,22)
+63 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(75))
if PSGAL(75)=X
DO KILL^PSGAL5
KILL PSGAL
+64 SET X=$PIECE(DIKZ(4),U,23)
+65 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(76))
if PSGAL(76)=X
DO KILL^PSGAL5
KILL PSGAL
+66 SET X=$PIECE(DIKZ(4),U,24)
+67 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(77))
if PSGAL(77)=X
DO KILL^PSGAL5
KILL PSGAL
+68 SET X=$PIECE(DIKZ(0),U,20)
+69 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(79))
if PSGAL(79)=X
DO KILL^PSGAL5
KILL PSGAL
+70 SET X=$PIECE(DIKZ(0),U,20)
+71 IF X'=""
SET ^PS(55,"AUDDD",$EXTRACT(X,1,30),DA(1),DA)=""
+72 SET DIKZ(6.5)=$GET(^PS(55,DA(1),5,DA,6.5))
+73 SET X=$PIECE(DIKZ(6.5),U,1)
+74 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(78))
if PSGAL(78)=X
DO KILL^PSGAL5
KILL PSGAL
+75 SET X=$PIECE(DIKZ(0),U,21)
+76 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(80))
if PSGAL(80)=X
DO KILL^PSGAL5
KILL PSGAL
+77 SET DIKZ(.1)=$GET(^PS(55,DA(1),5,DA,.1))
+78 SET X=$PIECE(DIKZ(.1),U,1)
+79 IF X'=""
SET ^PS(55,DA(1),5,"C",$EXTRACT(X,1,30),DA)=""
+80 SET X=$PIECE(DIKZ(.1),U,1)
+81 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(101))
if PSGAL(101)=X
DO KILL^PSGAL5
KILL PSGAL
+82 SET X=$PIECE(DIKZ(.1),U,2)
+83 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(102))
if PSGAL(102)=X
DO KILL^PSGAL5
KILL PSGAL
+84 SET X=$PIECE(DIKZ(0),U,24)
+85 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(103))
if PSGAL(103)=X
DO KILL^PSGAL5
KILL PSGAL
+86 SET X=$PIECE(DIKZ(0),U,25)
+87 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(104))
if PSGAL(104)=X
DO KILL^PSGAL5
KILL PSGAL
+88 SET X=$PIECE(DIKZ(0),U,26)
+89 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(105))
if PSGAL(105)=X
DO KILL^PSGAL5
KILL PSGAL
+90 SET X=$PIECE(DIKZ(.1),U,3)
+91 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(106))
if PSGAL(106)=X
DO KILL^PSGAL5
KILL PSGAL
+92 SET X=$PIECE(DIKZ(0),U,27)
+93 IF X'=""
IF '$DATA(DIU(0))
if $DATA(PSGAL(107))
if PSGAL(107)=X
DO KILL^PSGAL5
KILL PSGAL
+94 if '$DATA(DIKLM)
GOTO A^PSJXR514
if $DATA(DISET)
QUIT
END GOTO ^PSJXR516
