PSJXR512.m

PSJXR512 ; COMPILED XREF FOR FILE #55 ; 11/17/04

 ; 

 S DIKZK=1

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

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

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

 S X=$P(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(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(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(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(DIKZ("SAND"),U,1)

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

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

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

END G ^PSJXR513

PSJXR512  ; COMPILED XREF FOR FILE #55 ; 11/17/04

 +1       ; 

 +2        SET DIKZK=1

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

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

 +5        IF X'=""

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

 +6        SET X=$PIECE(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(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(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(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(DIKZ("SAND"),U,1)

 +16       IF X'=""

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

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

 +18       IF X'=""

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

END        GOTO ^PSJXR513