PSOCAN3N.m

PSOCAN3N ;BIR/RTR/SAB/SJA - auto dc rxs due to death ;06/29/07 11:45am

 ;;7.0;OUTPATIENT PHARMACY;**225**;DEC 1997;Build 29

 Q

RMP ;remove Rx if found in array PSORX("PSOL") (Label Queue)

 Q:'$D(PSORX("PSOL"))  S:'$G(DA) DA=$P(PSOLST(ORN),"^",2)

 N I,J,FND,ST1,ST2,ST3 S I=0

 F  S I=$O(PSORX("PSOL",I)) Q:'I  D

 . S ST1=PSORX("PSOL",I) Q:ST1'[(DA_",")

 . S ST3="",FND=0

 . F J=1:1 S ST2=$P(ST1,",",J) Q:'ST2  D

 . . I ST2=DA S FND=1 Q

 . . S ST3=ST3_$S('ST3:"",1:",")_ST2

 . I FND D

 . . S:ST3]"" PSORX("PSOL",I)=ST3_","

 . . K:ST3="" PSORX("PSOL",I)

 . . D:$D(BBRX(I)) RMB^PSOCAN2(I)

 Q

PSOCAN3N  ;BIR/RTR/SAB/SJA - auto dc rxs due to death ;06/29/07 11:45am

 +1       ;;7.0;OUTPATIENT PHARMACY;**225**;DEC 1997;Build 29

 +2        QUIT 

RMP       ;remove Rx if found in array PSORX("PSOL") (Label Queue)

 +1        IF '$DATA(PSORX("PSOL"))

               QUIT 

           IF '$GET(DA)

               SET DA=$PIECE(PSOLST(ORN),"^",2)

 +2        NEW I,J,FND,ST1,ST2,ST3

           SET I=0

 +3        FOR 

               SET I=$ORDER(PSORX("PSOL",I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +4                SET ST1=PSORX("PSOL",I)

                   IF ST1'[(DA_",")

                       QUIT 

 +5                SET ST3=""

                   SET FND=0

 +6                FOR J=1:1

                       SET ST2=$PIECE(ST1,",",J)

                       IF 'ST2

                           QUIT 

                       Begin DoDot:2

 +7                        IF ST2=DA

                               SET FND=1

                               QUIT 

 +8                        SET ST3=ST3_$SELECT('ST3:"",1:",")_ST2

                       End DoDot:2

 +9                IF FND

                       Begin DoDot:2

 +10                       IF ST3]""

                               SET PSORX("PSOL",I)=ST3_","

 +11                       IF ST3=""

                               KILL PSORX("PSOL",I)

 +12                       IF $DATA(BBRX(I))

                               DO RMB^PSOCAN2(I)

                       End DoDot:2

               End DoDot:1

 +13       QUIT