PSSVX64 ; COMPILED XREF FOR FILE #52.6 ; 11/28/17
;
S DIKZK=1
S DIKZ(0)=$G(^PS(52.6,DA,0))
S X=$P($G(DIKZ(0)),U,1)
I X'="" S ^PS(52.6,"B",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,2)
I X'="" S ^PS(52.6,"AC",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,2)
I X'="" I $P($G(^PSDRUG(X,2)),"^",3)'["I" S PSIUDA=X,PSIUX="I" D ENS^PSSGIU
S X=$P($G(DIKZ(0)),U,2)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S (DIV,X)=$P($G(^PSDRUG(X,2)),U,6) I DIV S DIU=$P($G(^PS(52.6,DA,0)),U,12) I DIV'=DIU S $P(^(0),U,12)=DIV I $O(^DD(52.6,16,1,0)) S (D0,DIV(0))=DA,DIH=52.6,DIG=16 D ^DICR
S X=$P($G(DIKZ(0)),U,2)
I X'="" D S526^PSSPOID1
S DIKZ("I")=$G(^PS(52.6,DA,"I"))
S X=$P($G(DIKZ("I")),U,1)
I X'="" X ^DD(52.6,12,1,1,1)
S DIKZ(0)=$G(^PS(52.6,DA,0))
S X=$P($G(DIKZ(0)),U,11)
I X'="" S ^PS(52.6,"AOI",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,12)
I X'="" S ^PS(52.6,"APD",$E(X,1,30),DA)=""
S X=$P($G(DIKZ(0)),U,13)
I X'="" X ^DD(52.6,17,1,1,1)
END G ^PSSVX65
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSVX64 975 printed Dec 13, 2024@02:34:45 Page 2
PSSVX64 ; COMPILED XREF FOR FILE #52.6 ; 11/28/17
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^PS(52.6,DA,0))
+4 SET X=$PIECE($GET(DIKZ(0)),U,1)
+5 IF X'=""
SET ^PS(52.6,"B",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE($GET(DIKZ(0)),U,2)
+7 IF X'=""
SET ^PS(52.6,"AC",$EXTRACT(X,1,30),DA)=""
+8 SET X=$PIECE($GET(DIKZ(0)),U,2)
+9 IF X'=""
IF $PIECE($GET(^PSDRUG(X,2)),"^",3)'["I"
SET PSIUDA=X
SET PSIUX="I"
DO ENS^PSSGIU
+10 SET X=$PIECE($GET(DIKZ(0)),U,2)
+11 IF X'=""
Begin DoDot:1
+12 NEW DIK,DIV,DIU,DIN
+13 KILL DIV
SET (DIV,X)=$PIECE($GET(^PSDRUG(X,2)),U,6)
IF DIV
SET DIU=$PIECE($GET(^PS(52.6,DA,0)),U,12)
IF DIV'=DIU
SET $PIECE(^(0),U,12)=DIV
IF $ORDER(^DD(52.6,16,1,0))
SET (D0,DIV(0))=DA
SET DIH=52.6
SET DIG=16
DO ^DICR
End DoDot:1
+14 SET X=$PIECE($GET(DIKZ(0)),U,2)
+15 IF X'=""
DO S526^PSSPOID1
+16 SET DIKZ("I")=$GET(^PS(52.6,DA,"I"))
+17 SET X=$PIECE($GET(DIKZ("I")),U,1)
+18 IF X'=""
XECUTE ^DD(52.6,12,1,1,1)
+19 SET DIKZ(0)=$GET(^PS(52.6,DA,0))
+20 SET X=$PIECE($GET(DIKZ(0)),U,11)
+21 IF X'=""
SET ^PS(52.6,"AOI",$EXTRACT(X,1,30),DA)=""
+22 SET X=$PIECE($GET(DIKZ(0)),U,12)
+23 IF X'=""
SET ^PS(52.6,"APD",$EXTRACT(X,1,30),DA)=""
+24 SET X=$PIECE($GET(DIKZ(0)),U,13)
+25 IF X'=""
XECUTE ^DD(52.6,17,1,1,1)
END GOTO ^PSSVX65
