PSSJXR17.m

PSSJXR17 ; COMPILED XREF FOR FILE #55 ; 08/08/13

 ; 

 S DIKZK=1

 S DIKZ(0)=$G(^PS(55,DA,0))

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" S ^PS(55,"B",$E(X,1,30),DA)=""

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I '$D(PSGINITF) S ^PS(55,"ALCNVRT")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I '$D(PSGINITF) S ^PS(55,"AUDDD")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")

 S X=$P($G(DIKZ(0)),U,1)

 I X'="" I '$D(PSGINITF) S ^PS(55,"AUDAPM")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")

 S X=$P($G(DIKZ(0)),U,4)

 I X'="" S ^PS(55,"ADIA",$E(X,1,30),DA)=""

 S DIKZ("SAND")=$G(^PS(55,DA,"SAND"))

 S X=$P($G(DIKZ("SAND")),U,1)

 I X'="" S ^PS(55,"ASAND",DA)=""

 S X=$P($G(DIKZ("SAND")),U,1)

 I X'="" S ^PS(55,"ASAND1",$E(X,1,30),DA)=""

CR1 S DIXR=472

 K X

 S X(1)=$P(DIKZ(0),U,7)

 S X=$G(X(1))

 I $G(X(1))]"" D

 . K X1,X2 M X1=X,X2=X

 . D LOGDFN^PSUHL(DA)

CR2 K X

END G ^PSSJXR18

PSSJXR17  ; COMPILED XREF FOR FILE #55 ; 08/08/13

 +1       ; 

 +2        SET DIKZK=1

 +3        SET DIKZ(0)=$GET(^PS(55,DA,0))

 +4        SET X=$PIECE($GET(DIKZ(0)),U,1)

 +5        IF X'=""

               SET ^PS(55,"B",$EXTRACT(X,1,30),DA)=""

 +6        SET X=$PIECE($GET(DIKZ(0)),U,1)

 +7        IF X'=""

               IF '$DATA(PSGINITF)

                   SET ^PS(55,"ALCNVRT")=$SELECT($DATA(^PS(59.7,1,20)):$PIECE(^(20),"^"),1:"")

 +8        SET X=$PIECE($GET(DIKZ(0)),U,1)

 +9        IF X'=""

               IF '$DATA(PSGINITF)

                   SET ^PS(55,"AUDDD")=$SELECT($DATA(^PS(59.7,1,20)):$PIECE(^(20),"^"),1:"")

 +10       SET X=$PIECE($GET(DIKZ(0)),U,1)

 +11       IF X'=""

               IF '$DATA(PSGINITF)

                   SET ^PS(55,"AUDAPM")=$SELECT($DATA(^PS(59.7,1,20)):$PIECE(^(20),"^"),1:"")

 +12       SET X=$PIECE($GET(DIKZ(0)),U,4)

 +13       IF X'=""

               SET ^PS(55,"ADIA",$EXTRACT(X,1,30),DA)=""

 +14       SET DIKZ("SAND")=$GET(^PS(55,DA,"SAND"))

 +15       SET X=$PIECE($GET(DIKZ("SAND")),U,1)

 +16       IF X'=""

               SET ^PS(55,"ASAND",DA)=""

 +17       SET X=$PIECE($GET(DIKZ("SAND")),U,1)

 +18       IF X'=""

               SET ^PS(55,"ASAND1",$EXTRACT(X,1,30),DA)=""

CR1        SET DIXR=472

 +1        KILL X

 +2        SET X(1)=$PIECE(DIKZ(0),U,7)

 +3        SET X=$GET(X(1))

 +4        IF $GET(X(1))]""

               Begin DoDot:1

 +5                KILL X1,X2

                   MERGE X1=X,X2=X

 +6                DO LOGDFN^PSUHL(DA)

               End DoDot:1

CR2        KILL X

END        GOTO ^PSSJXR18