- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCAN3N 605 printed Feb 18, 2025@23:51:41 Page 2
- 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
