PSSVX61.m

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

 ; 

 S DIKZK=2

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

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

 I X'="" K ^PS(52.6,"AC",$E(X,1,30),DA)

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

 I X'="" I '$D(^PS(52.7,"AC",X)) S XX=$O(^PS(52.6,"AC",X,0)) S:XX=DA XX=$O(^(XX)) I XX,$P($G(^PSDRUG(X,2)),"^",3)["I" S PSIUDA=X,PSIUX="I" D END^PSSGIU

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

 I X'="" D

 .N DIK,DIV,DIU,DIN

 .S DIU=$P($G(^PS(52.6,DA,0)),U,12) I DIU]"" S $P(^(0),U,12)="" I $O(^DD(52.6,16,1,0)) K DIV S (DIV,X)="",(D0,DIV(0))=DA,DIH=52.6,DIG=16 D ^DICR

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

 I X'="" D K526^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,2)

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

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

 I X'="" K ^PS(52.6,"AOI",$E(X,1,30),DA)

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

 I X'="" K ^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,2)

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

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

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

END G ^PSSVX62

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

 +1       ; 

 +2        SET DIKZK=2

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

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

 +5        IF X'=""

               KILL ^PS(52.6,"AC",$EXTRACT(X,1,30),DA)

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

 +7        IF X'=""

               IF '$DATA(^PS(52.7,"AC",X))

                   SET XX=$ORDER(^PS(52.6,"AC",X,0))

                   IF XX=DA

                       SET XX=$ORDER(^(XX))

                   IF XX

                       IF $PIECE($GET(^PSDRUG(X,2)),"^",3)["I"

                           SET PSIUDA=X

                           SET PSIUX="I"

                           DO END^PSSGIU

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

 +9        IF X'=""

               Begin DoDot:1

 +10               NEW DIK,DIV,DIU,DIN

 +11               SET DIU=$PIECE($GET(^PS(52.6,DA,0)),U,12)

                   IF DIU]""

                       SET $PIECE(^(0),U,12)=""

                       IF $ORDER(^DD(52.6,16,1,0))

                           KILL DIV

                           SET (DIV,X)=""

                           SET (D0,DIV(0))=DA

                           SET DIH=52.6

                           SET DIG=16

                           DO ^DICR

               End DoDot:1

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

 +13       IF X'=""

               DO K526^PSSPOID1

 +14       SET DIKZ("I")=$GET(^PS(52.6,DA,"I"))

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

 +16       IF X'=""

               XECUTE ^DD(52.6,12,1,1,2)

 +17       SET DIKZ(0)=$GET(^PS(52.6,DA,0))

 +18       SET X=$PIECE($GET(DIKZ(0)),U,11)

 +19       IF X'=""

               KILL ^PS(52.6,"AOI",$EXTRACT(X,1,30),DA)

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

 +21       IF X'=""

               KILL ^PS(52.6,"APD",$EXTRACT(X,1,30),DA)

 +22       SET X=$PIECE($GET(DIKZ(0)),U,13)

 +23       IF X'=""

               XECUTE ^DD(52.6,17,1,1,2)

 +24       SET DIKZ(0)=$GET(^PS(52.6,DA,0))

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

 +26       IF X'=""

               KILL ^PS(52.6,"B",$EXTRACT(X,1,30),DA)

END        GOTO ^PSSVX62