PSSVX64.m

PSSVX64 ; COMPILED XREF FOR FILE #52.6 ; 08/08/13

 ; 

 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

PSSVX64   ; COMPILED XREF FOR FILE #52.6 ; 08/08/13

 +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