Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORXL1.m

    r613 r623  
    1 PSORXL1 ;BIR/SAB-action to be taken on prescriptions ; 10/5/07 2:40pm
    2         ;;7.0;OUTPATIENT PHARMACY;**36,46,148,260,274**;DEC 1997;Build 8
    3 S       S SPPL="",PPL1=1 S:'$G(PPL) PPL=$G(PSORX("PSOL",PPL1)) G:$G(PPL)']"" D1
    4 S1      F PI=1:1 Q:$P(PPL,",",PI)=""  S DA=$P(PPL,",",PI) D
    5         .I $P(^PSRX(DA,"STA"),"^")<10,$P(^("STA"),"^")'=4 D SUS Q
    6         .I $P(^PSRX(DA,"STA"),"^")=4 S SPPL=SPPL_DA_"," Q
    7         I $G(SPPL)]"" D  K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DUOUT,DTOUT,DIRUT
    8         .W !!,$C(7),"Drug Interaction Rx(s) " F I=1:1 Q:$P(SPPL,",",I)=""  W $P(^PSRX($P(SPPL,",",I),0),"^")_", "
    9         .I $G(PSOLAP)=""!($G(PSOLAP)=$G(ION)) W !,"Label device must be selected for Drug Interaction label!"
    10         .S PPL=SPPL,DG=1 N PPL1 D Q^PSORXL K DG,SPPL
    11         S SUSPT="SUSPENSE" G D1
    12         Q
    13 SUS     S ACT=1,RXN=DA,RX0=^PSRX(DA,0),SD=$S($G(ZD(DA)):$E(ZD(DA),1,7),1:$P(^(3),"^")),RXS=$O(^PS(52.5,"B",DA,0)) I RXS S RXCMOP=$P($G(^PS(52.5,RXS,0)),"^",7) D  Q:$G(DFLG)!($G(PSOWFLG))
    14         .;checks to see if future fill exists
    15         .S PSOWFLG=0 I '$G(RXPR(DA)),$P($G(^PS(52.5,RXS,"P")),"^")=0,$P($G(^PSRX(DA,"STA")),"^")=5 D SWARN Q:$G(PSOWFLG)
    16         .K PSOWFLG I $G(RXPR(DA)),'$P($G(^PS(52.5,RXS,"P")),"^") D WARN Q:$G(DFLG)
    17         .S DA=RXS,DIK="^PS(52.5," D ^DIK S DA=RXN I $P($G(^PSRX(RXN,"STA")),"^")=5 S $P(^("STA"),"^")=0
    18         G:$G(RXRP(DA))!($G(RXPR(DA))) LOCK
    19         I $G(PSXSYS) D SUS1^PSOCMOP I $G(XFLAG)=1 K XFLAG Q
    20 LOCK    I $P($G(^PSRX(RXN,"STA")),"^")=3 G SUSQ
    21         S RXP=+$G(RXPR(DA)),DIC="^PS(52.5,",DIC(0)="L",X=RXN,DIC("DR")=".02///"_SD_";.03////"_$P(^PSRX(DA,0),"^",2)_";.04///M;.05///"_RXP_";.06////"_PSOSITE_";2///0" K DD,DO D FILE^DICN D  I +Y,'$G(RXP),$G(RXRP(RXN)) S $P(^PS(52.5,+Y,0),"^",12)=1
    22         .K DD,DO I +Y,$G(PSOEXREP) S $P(^PS(52.5,+Y,0),"^",12)=1
    23         .I +Y S $P(^PS(52.5,+Y,0),"^",13)=$G(RXFL(RXN))
    24         S $P(^PSRX(RXN,"STA"),"^")=5,LFD=$E(SD,4,5)_"-"_$E(SD,6,7)_"-"_$E(SD,2,3) D ACT
    25         W !!,$S(RXP:"Partial ",1:"")_"RX# ",$P(^PSRX(RXN,0),"^")_" has been suspended until "_LFD_"."
    26         S VALMSG=$S(RXP:"Partial ",1:"")_"Rx# "_$P(^PSRX(RXN,0),"^")_" Has Been Suspended Until "_LFD_"."_$S($G(RXRP(RXN))&('$G(RXP)):" (Reprint)",1:"")
    27         S COMM=$S(RXP:"Partial ",1:"")_"Rx# "_$P(^PSRX(RXN,0),"^")_" Has Been Suspended Until "_LFD_"."_$S($G(RXRP(RXN))&('$G(RXP)):" (Reprint)",1:"")
    28         D:'$D(^TMP("PSORXN",$J,RXN)) EN^PSOHLSN1(RXN,"SC","ZS",COMM)
    29         S:$D(^TMP("PSORXN",$J,RXN)) $P(^TMP("PSORXN",$J,RXN),"^",4)=COMM
    30         ;
    31         ; - If not a PARTIAL, reverse ECME Claim, if necessary
    32         I '$G(RXP) D REVERSE^PSOBPSU1(RXN,,"DC",3)
    33         K COMM
    34 SUSQ    Q
    35         ;PSO*7*274 allways recalculate RXF
    36 ACT     S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I  S RXF=I S:I>5 RXF=I+1
    37         S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA  S IR=FDA
    38         S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
    39         D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^S^"_DUZ_"^"_RXF_"^"_$S(RXP:"Partial ",1:"")_"RX "_$S($G(RXRP(DA))&('$G(RXP)):"Reprint ",1:"")_"Placed on Suspense until "_LFD K RXF,I,FDA,DIC,DIE,DR,Y,X,%,%H,%I
    40         Q
    41 D1      I $O(PSORX("PSOL",$G(PPL1))) S PPL1=$O(PSORX("PSOL",$G(PPL1))),PPL=PSORX("PSOL",PPL1) G S1
    42         G:$D(RXRS) RXS^PSORXL
    43         K LBL,PPL1,PPL,DIR,%DT,%,SD,COUNT,EXDT,L,PDUZ,REF,REPRINT,RFDATE,RFL1,RFLL,RXN,WARN,ZY,FLD,PI,ZD,ACT,X,Y,DIRUT,DUOUT,DTOUT,DIROUT,DFLG,RXPD,PSOWFLG
    44         Q
    45 WARN    W ! K DIR,DIRUT,DUOUT,DTOUT,DFLG S Y=$P(^PS(52.5,RXS,0),"^",2) X ^DD("DD") S RXPD=Y,DIR(0)="SA^S:SUSPEND;Q:QUEUE;E:EXIT"
    46         S DIR("A",1)="Rx #"_$P(^PSRX(DA,0),"^")_" is suspended "_$S($G(RXCMOP)]"":"for CMOP ",1:"")_"until "_RXPD
    47         I $G(RXCMOP)]"" D  G WARN1
    48         .W !!,"A partial entered for this Rx cannot be suspended."
    49         .W !,"You may pull this fill from suspense or print the label now.",!!
    50         .S DIR("A",2)=" ",DIR("A",3)="   Do you want to Queue to print",DIR("A")="                or Exit: "
    51         S DIR("A",2)=" ",DIR("A",3)="   Do you want to: Suspend Partial",DIR("A",4)="                   Queue to print",DIR("A")="                or Exit:  "
    52 WARN1   S DIR("B")="EXIT",DIR("?")="^D HLP^PSORXL1" D ^DIR K DIR
    53         I Y="E"!($D(DIRUT))!(Y="S"&($G(RXCMOP)]"")) S DA(1)=DA,DA=RXPR(DA),DIK="^PSRX("_DA(1)_",""P""," D ^DIK S ^PSRX(DA(1),"TYPE")=0,DFLG=1 W $C(7)," Partial Removed!" Q
    54         I Y="Q" S DPPL=PPL,HOLDPPL1=$G(PPL1),DPI=PI,RXLTOP=1 S PPL=$G(RXN)_"," S PSPARTXX=1 D Q^PSORXL K PSPARTXX S DFLG=1,PPL=DPPL,PI=DPI,PPL1=$G(HOLDPPL1) K HOLDPPL1,DPPL,DPPI,DPI,RXLTOP Q
    55         Q
    56 HLP     I $G(RXCMOP)']"" W !!,"If you choose to suspend this partial Rx, the current suspended fill will",!,"be replaced by the partial.  You may want to pull this fill early instead.",!
    57         I $G(RXCMOP)]"" W !!,"You cannot suspend a partial when a CMOP fill is in suspense, because the partial will replace the CMOP fill in suspense."
    58         W !,"If you choose to queue this partial, the label will printout on the previous",!,"selected label printer.",!
    59         W !,"You may exit without printing or suspending this partial.  This will also delete",!,"the partial Rx entered."
    60         Q
    61 SWARN   ;
    62         S PSORXLDA=$G(DA),PSORXZD=$P($G(^PS(52.5,RXS,0)),"^",2)
    63         W $C(7),!!,"Rx "_$P($G(^PSRX(DA,0)),"^")_" is already suspended "_$S($G(RXCMOP)]"":"for CMOP ",1:"")_"until "_$E(PSORXZD,4,5)_"-"_$E(PSORXZD,6,7)_"-"_$E(PSORXZD,2,3)_"." K PSORXZD
    64         W !,"By suspending this fill, the fill that is already suspended will be overwritten",!,"and a label will not print for that fill!",!
    65         K DIR S DIR(0)="SA^Q:QUEUE;S:SUSPEND",DIR("B")="Q",DIR("A")="Do you want to Queue to print or Suspend Rx "_$P($G(^PSRX(DA,0)),"^")_": " D ^DIR K DIR
    66         I $G(Y)="S" K RXFL(PSORXLDA) G SWARNQ
    67         I $G(Y)="Q" D  G SWARNQ
    68         . S PSOKSPPL=$G(PPL),PSOZXPPL=$G(PPL1),PSOZXPI=$G(PI),RXLTOP=1
    69         . S PPL=$G(RXN)_"," D SWARS D Q^PSORXL S PSOWFLG=1,PPL=PSOKSPPL
    70         . S PI=PSOZXPI,PPL1=PSOZXPPL K PSOKSPPL,PSOZXPPL,PSOZXPI,RXLTOP,RXFL(+$G(PSORXLDA))
    71         W !!,"Nothing queued to print for Rx "_$P($G(^PSRX(PSORXLDA,0)),"^"),! S PSOWFLG=1
    72 SWARNQ  ;
    73         S DA=$G(PSORXLDA) K PSORXLDA
    74         Q
    75 SWARS   ;
    76         S PSOZXFL(PSORXLDA)=+$P($G(^PS(52.5,+$G(RXS),0)),"^",13) I '$G(PSOZXFL(PSORXLDA)) K PSOZXFL Q
    77         S PSOZXFPL=$P(PSOKSPPL,",",+$G(PI),99)
    78         S PSOZXFPN=$L(PSOZXFPL,PPL)-1
    79         I $G(PSOZXFL(PSORXLDA)),$G(PSOZXFPN) S RXFL(PSORXLDA)=$G(PSOZXFL(PSORXLDA))-$G(PSOZXFPN)
    80         K PSOZXFL,PSOZXFPL,PSOZXFPN
    81         Q
    82 ECME    ; - Looks for DUR/79 REJECTS and send Mail Rx's to ECME that have not been SUSPENDED
    83         N PSOI,PSOJ,PSORX,PSORF,PSOACT,BWH,PPLTMP
    84         S PPLTMP=$G(PPL)
    85         F PSOI=1:1 S PSORX=+$P($G(PPL),",",PSOI) Q:'PSORX  D
    86         . I $G(RXPR(PSORX)) Q
    87         . S PSOACT="",PSORF=$$LSTRFL^PSOBPSU1(PSORX)
    88         . S BWH=$S(PSORF:"RF",1:"OF")
    89         . I $$FIND^PSOREJUT(PSORX,PSORF) D  I PSOACT="Q" D RMV(PSORX,.PPLTMP) Q
    90         . . S PSOACT=$$HDLG^PSOREJU1(PSORX,PSORF,"79,88",BWH,"OIQ","Q")
    91         S:$G(PPLTMP)'="" PPL=PPLTMP
    92         Q
    93 RMV(RX,PPL)     ; Remove the Rx from the label print queue
    94         N XPPL,I
    95         S XPPL=PPL,PPL="" F I=1:1:$L(XPPL,",") I $P(XPPL,",",I)'="",$P(XPPL,",",I)'=RX S PPL=PPL_$P(XPPL,",",I)_","
    96         I PPL="" K PPL
    97         Q
     1PSORXL1 ;BIR/SAB-action to be taken on prescriptions ;03/01/96
     2 ;;7.0;OUTPATIENT PHARMACY;**36,46,148,260**;DEC 1997;Build 84
     3S S SPPL="",PPL1=1 S:'$G(PPL) PPL=$G(PSORX("PSOL",PPL1)) G:$G(PPL)']"" D1
     4S1 F PI=1:1 Q:$P(PPL,",",PI)=""  S DA=$P(PPL,",",PI) D
     5 .I $P(^PSRX(DA,"STA"),"^")<10,$P(^("STA"),"^")'=4 D SUS Q
     6 .I $P(^PSRX(DA,"STA"),"^")=4 S SPPL=SPPL_DA_"," Q
     7 I $G(SPPL)]"" D  K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DUOUT,DTOUT,DIRUT
     8 .W !!,$C(7),"Drug Interaction Rx(s) " F I=1:1 Q:$P(SPPL,",",I)=""  W $P(^PSRX($P(SPPL,",",I),0),"^")_", "
     9 .I $G(PSOLAP)=""!($G(PSOLAP)=$G(ION)) W !,"Label device must be selected for Drug Interaction label!"
     10 .S PPL=SPPL,DG=1 N PPL1 D Q^PSORXL K DG,SPPL
     11 S SUSPT="SUSPENSE" G D1
     12 Q
     13SUS S ACT=1,RXN=DA,RX0=^PSRX(DA,0),SD=$S($G(ZD(DA)):$E(ZD(DA),1,7),1:$P(^(3),"^")),RXS=$O(^PS(52.5,"B",DA,0)) I RXS S RXCMOP=$P($G(^PS(52.5,RXS,0)),"^",7) D  Q:$G(DFLG)!($G(PSOWFLG))
     14 .;checks to see if future fill exists
     15 .S PSOWFLG=0 I '$G(RXPR(DA)),$P($G(^PS(52.5,RXS,"P")),"^")=0,$P($G(^PSRX(DA,"STA")),"^")=5 D SWARN Q:$G(PSOWFLG)
     16 .K PSOWFLG I $G(RXPR(DA)),'$P($G(^PS(52.5,RXS,"P")),"^") D WARN Q:$G(DFLG)
     17 .S DA=RXS,DIK="^PS(52.5," D ^DIK S DA=RXN I $P($G(^PSRX(RXN,"STA")),"^")=5 S $P(^("STA"),"^")=0
     18 G:$G(RXRP(DA))!($G(RXPR(DA))) LOCK
     19 I $G(PSXSYS) D SUS1^PSOCMOP I $G(XFLAG)=1 K XFLAG Q
     20LOCK I $P($G(^PSRX(RXN,"STA")),"^")=3 G SUSQ
     21 S RXP=+$G(RXPR(DA)),DIC="^PS(52.5,",DIC(0)="L",X=RXN,DIC("DR")=".02///"_SD_";.03////"_$P(^PSRX(DA,0),"^",2)_";.04///M;.05///"_RXP_";.06////"_PSOSITE_";2///0" K DD,DO D FILE^DICN D  I +Y,'$G(RXP),$G(RXRP(RXN)) S $P(^PS(52.5,+Y,0),"^",12)=1
     22 .K DD,DO I +Y,$G(PSOEXREP) S $P(^PS(52.5,+Y,0),"^",12)=1
     23 .I +Y S $P(^PS(52.5,+Y,0),"^",13)=$G(RXFL(RXN))
     24 S $P(^PSRX(RXN,"STA"),"^")=5,LFD=$E(SD,4,5)_"-"_$E(SD,6,7)_"-"_$E(SD,2,3) D ACT
     25 W !!,$S(RXP:"Partial ",1:"")_"RX# ",$P(^PSRX(RXN,0),"^")_" has been suspended until "_LFD_"."
     26 S VALMSG=$S(RXP:"Partial ",1:"")_"Rx# "_$P(^PSRX(RXN,0),"^")_" Has Been Suspended Until "_LFD_"."_$S($G(RXRP(RXN))&('$G(RXP)):" (Reprint)",1:"")
     27 S COMM=$S(RXP:"Partial ",1:"")_"Rx# "_$P(^PSRX(RXN,0),"^")_" Has Been Suspended Until "_LFD_"."_$S($G(RXRP(RXN))&('$G(RXP)):" (Reprint)",1:"")
     28 D:'$D(^TMP("PSORXN",$J,RXN)) EN^PSOHLSN1(RXN,"SC","ZS",COMM)
     29 S:$D(^TMP("PSORXN",$J,RXN)) $P(^TMP("PSORXN",$J,RXN),"^",4)=COMM
     30 ;
     31 ; - If not a PARTIAL, reverse ECME Claim, if necessary
     32 I '$G(RXP) D REVERSE^PSOBPSU1(RXN,,"DC",3)
     33 K COMM
     34SUSQ Q
     35ACT I '$D(RXF) S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I  S RXF=I S:I>5 RXF=I+1
     36 S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA  S IR=FDA
     37 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
     38 D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^S^"_DUZ_"^"_RXF_"^"_$S(RXP:"Partial ",1:"")_"RX "_$S($G(RXRP(DA))&('$G(RXP)):"Reprint ",1:"")_"Placed on Suspense until "_LFD K RXF,I,FDA,DIC,DIE,DR,Y,X,%,%H,%I
     39 Q
     40D1 I $O(PSORX("PSOL",$G(PPL1))) S PPL1=$O(PSORX("PSOL",$G(PPL1))),PPL=PSORX("PSOL",PPL1) G S1
     41 G:$D(RXRS) RXS^PSORXL
     42 K LBL,PPL1,PPL,DIR,%DT,%,SD,COUNT,EXDT,L,PDUZ,REF,REPRINT,RFDATE,RFL1,RFLL,RXN,WARN,ZY,FLD,PI,ZD,ACT,X,Y,DIRUT,DUOUT,DTOUT,DIROUT,DFLG,RXPD,PSOWFLG
     43 Q
     44WARN W ! K DIR,DIRUT,DUOUT,DTOUT,DFLG S Y=$P(^PS(52.5,RXS,0),"^",2) X ^DD("DD") S RXPD=Y,DIR(0)="SA^S:SUSPEND;Q:QUEUE;E:EXIT"
     45 S DIR("A",1)="Rx #"_$P(^PSRX(DA,0),"^")_" is suspended "_$S($G(RXCMOP)]"":"for CMOP ",1:"")_"until "_RXPD
     46 I $G(RXCMOP)]"" D  G WARN1
     47 .W !!,"A partial entered for this Rx cannot be suspended."
     48 .W !,"You may pull this fill from suspense or print the label now.",!!
     49 .S DIR("A",2)=" ",DIR("A",3)="   Do you want to Queue to print",DIR("A")="                or Exit: "
     50 S DIR("A",2)=" ",DIR("A",3)="   Do you want to: Suspend Partial",DIR("A",4)="                   Queue to print",DIR("A")="                or Exit:  "
     51WARN1 S DIR("B")="EXIT",DIR("?")="^D HLP^PSORXL1" D ^DIR K DIR
     52 I Y="E"!($D(DIRUT))!(Y="S"&($G(RXCMOP)]"")) S DA(1)=DA,DA=RXPR(DA),DIK="^PSRX("_DA(1)_",""P""," D ^DIK S ^PSRX(DA(1),"TYPE")=0,DFLG=1 W $C(7)," Partial Removed!" Q
     53 I Y="Q" S DPPL=PPL,HOLDPPL1=$G(PPL1),DPI=PI,RXLTOP=1 S PPL=$G(RXN)_"," S PSPARTXX=1 D Q^PSORXL K PSPARTXX S DFLG=1,PPL=DPPL,PI=DPI,PPL1=$G(HOLDPPL1) K HOLDPPL1,DPPL,DPPI,DPI,RXLTOP Q
     54 Q
     55HLP I $G(RXCMOP)']"" W !!,"If you choose to suspend this partial Rx, the current suspended fill will",!,"be replaced by the partial.  You may want to pull this fill early instead.",!
     56 I $G(RXCMOP)]"" W !!,"You cannot suspend a partial when a CMOP fill is in suspense, because the partial will replace the CMOP fill in suspense."
     57 W !,"If you choose to queue this partial, the label will printout on the previous",!,"selected label printer.",!
     58 W !,"You may exit without printing or suspending this partial.  This will also delete",!,"the partial Rx entered."
     59 Q
     60SWARN ;
     61 S PSORXLDA=$G(DA),PSORXZD=$P($G(^PS(52.5,RXS,0)),"^",2)
     62 W $C(7),!!,"Rx "_$P($G(^PSRX(DA,0)),"^")_" is already suspended "_$S($G(RXCMOP)]"":"for CMOP ",1:"")_"until "_$E(PSORXZD,4,5)_"-"_$E(PSORXZD,6,7)_"-"_$E(PSORXZD,2,3)_"." K PSORXZD
     63 W !,"By suspending this fill, the fill that is already suspended will be overwritten",!,"and a label will not print for that fill!",!
     64 K DIR S DIR(0)="SA^Q:QUEUE;S:SUSPEND",DIR("B")="Q",DIR("A")="Do you want to Queue to print or Suspend Rx "_$P($G(^PSRX(DA,0)),"^")_": " D ^DIR K DIR
     65 I $G(Y)="S" K RXFL(PSORXLDA) G SWARNQ
     66 I $G(Y)="Q" D  G SWARNQ
     67 . S PSOKSPPL=$G(PPL),PSOZXPPL=$G(PPL1),PSOZXPI=$G(PI),RXLTOP=1
     68 . S PPL=$G(RXN)_"," D SWARS D Q^PSORXL S PSOWFLG=1,PPL=PSOKSPPL
     69 . S PI=PSOZXPI,PPL1=PSOZXPPL K PSOKSPPL,PSOZXPPL,PSOZXPI,RXLTOP,RXFL(+$G(PSORXLDA))
     70 W !!,"Nothing queued to print for Rx "_$P($G(^PSRX(PSORXLDA,0)),"^"),! S PSOWFLG=1
     71SWARNQ ;
     72 S DA=$G(PSORXLDA) K PSORXLDA
     73 Q
     74SWARS ;
     75 S PSOZXFL(PSORXLDA)=+$P($G(^PS(52.5,+$G(RXS),0)),"^",13) I '$G(PSOZXFL(PSORXLDA)) K PSOZXFL Q
     76 S PSOZXFPL=$P(PSOKSPPL,",",+$G(PI),99)
     77 S PSOZXFPN=$L(PSOZXFPL,PPL)-1
     78 I $G(PSOZXFL(PSORXLDA)),$G(PSOZXFPN) S RXFL(PSORXLDA)=$G(PSOZXFL(PSORXLDA))-$G(PSOZXFPN)
     79 K PSOZXFL,PSOZXFPL,PSOZXFPN
     80 Q
     81ECME ; - Looks for DUR/79 REJECTS and send Mail Rx's to ECME that have not been SUSPENDED
     82 N PSOI,PSOJ,PSORX,PSORF,PSOACT,BWH,PPLTMP
     83 S PPLTMP=$G(PPL)
     84 F PSOI=1:1 S PSORX=+$P($G(PPL),",",PSOI) Q:'PSORX  D
     85 . I $G(RXPR(PSORX)) Q
     86 . S PSOACT="",PSORF=$$LSTRFL^PSOBPSU1(PSORX)
     87 . S BWH=$S(PSORF:"RF",1:"OF")
     88 . I $$FIND^PSOREJUT(PSORX,PSORF) D  I PSOACT="Q" D RMV(PSORX,.PPLTMP) Q
     89 . . S PSOACT=$$HDLG^PSOREJU1(PSORX,PSORF,"79,88",BWH,"OIQ","Q")
     90 S:$G(PPLTMP)'="" PPL=PPLTMP
     91 Q
     92RMV(RX,PPL) ; Remove the Rx from the label print queue
     93 N XPPL,I
     94 S XPPL=PPL,PPL="" F I=1:1:$L(XPPL,",") I $P(XPPL,",",I)'="",$P(XPPL,",",I)'=RX S PPL=PPL_$P(XPPL,",",I)_","
     95 I PPL="" K PPL
     96 Q
Note: See TracChangeset for help on using the changeset viewer.