Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSORENW4

PSORENW4.m

Go to the documentation of this file.
  1. PSORENW4 ;BIR/SAB - rx speed renew ;Oct 20, 2022@15:42
  1. ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,37,64,46,75,71,100,130,117,152,148,264,225,301,390,313,411,444,504,508,550,457,639,441,683,545,731,753**;DEC 1997;Build 53
  1. ;External reference to ^PSDRUG( supported by DBIA 221
  1. ;External reference to ^PS(50.7 supported by DBIA 2223
  1. ;External reference to $$L^PSSLOCK supported by DBIA 2789
  1. ;External reference to UL^PSSLOCK supported by DBIA 2789
  1. ;External reference to PSOL^PSSLOCK supported by DBIA 2789
  1. ;External reference to PSOUL^PSSLOCK supported by DBIA 2789
  1. ;External reference to LK^ORX2 supported by DBIA 867
  1. ;External reference to ULK^ORX2 supported by DBIA 867
  1. ;External reference to ^PSRX supported by DBIA 3500
  1. ;External reference to ^VA(200 supported by DBIA 10060
  1. SEL K PSODRUG ;PSO*7*301
  1. N PSOSPRNW,PSOIBOLD S PSOSPRNW=1
  1. I $P(PSOPAR,"^",4)=0 S VALMSG="Renewing is NOT Allowed. Check Site Parameters!",VALMBCK="" Q
  1. N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!",VALMBCK="" Q
  1. S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q
  1. K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q
  1. K PRC,PHI,PSORX("EDIT"),PSOFDR,DIR,DUOUT,DIRUT,PSORNSPD
  1. S LST="",DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR
  1. K DIR I $D(DTOUT)!($D(DUOUT)) K DIRUT,DTOUT,DUOUT S VALMBCK="" G SELQ
  1. ;
  1. K DIRUT,PSOOELSE I +Y S (SPEED,PSOOELSE,PSORNSPD)=1 D FULL^VALM1 S LST=Y
  1. ; begin NCC remediation *457, remove any Clozapine orders
  1. I $G(LST)]"" F ORD=1:1:$L(LST,",") S ORN=$P(LST,",",ORD) D:ORN I PSOERR=2 S PSOERR=0
  1. . S PSOERR=0
  1. . N PSDRGIEN,ORDLN S ORDLN=$G(PSOLST(ORN)) Q:'(+ORDLN=52)
  1. . ; Clozapine check
  1. . S PSDRGIEN=$$GET1^DIQ(52,+$P(ORDLN,"^",2),6,"I") ; drug IEN
  1. . Q:'PSDRGIEN I $$GET1^DIQ(50,PSDRGIEN,17.5)="PSOCLO1" D
  1. .. S $P(LST,",",ORD)=0 ; order removed from LST
  1. .. W !,$$GET1^DIQ(50,PSDRGIEN,.01) ; drug name
  1. .. N DIR,ORUB,Y S Y("1")="^^Renew^RN",ORUB=1 D NS^XQORM4
  1. .. S Y=$$GET1^DIQ(52,+$P(ORDLN,U,2),.01) ; Rx #
  1. .. S PSOERR=2 S DIR(0)="E",DIR("A")="Rx #"_Y_" not processed. Press enter" D ^DIR
  1. ;
  1. ;PSO 683 skip discontinued by provider RXs
  1. S (ORD,PSOLCNT)=0
  1. I $G(LST)]"" D
  1. . ; count remaining orders in LST
  1. . F ORD=1:1:$L(LST,",")-1 D
  1. .. Q:$P(LST,",",ORD)'>0
  1. .. S PSOLCNT=PSOLCNT+1,ORN=$P(LST,",",ORD)
  1. .. I (+PSOLST(ORN)=52&(^PSRX($P(PSOLST(ORN),U,2),"STA")=14)) D
  1. ... S PSOSKIP($P(PSOLST(ORN),U,2))="",$P(LST,",",ORD)=0,PSOLCNT=PSOLCNT-1 ; order removed from LST
  1. .I $O(PSOSKIP(0)) D
  1. .. W !
  1. .. S ORD=0 F S ORD=$O(PSOSKIP(ORD)) Q:'ORD D
  1. ... S PSOSTA=$$GET1^DIQ(52,ORD,100)
  1. ... W $C(7),!," Cannot renew Rx # "_$$GET1^DIQ(52,ORD,.01)_", Rx is in "_PSOSTA_" status."
  1. .. D PAUSE^VALM1
  1. ;END PSO 683
  1. ;
  1. I 'PSOLCNT G SELQ ; no orders to process
  1. ; end NCC remediation *457
  1. D ; process remaining orders
  1. . S (PSODIR("DFLG"),PSODIR("FIELD"))=0,PSOOPT=3,(PSORENW("DFLG"),PSORENW("QFLG"),PSORX("DFLG"))=0 D INIT Q:PSORENW("DFLG")
  1. . F ORD=1:1:$L(LST,",") S ORN=$P(LST,",",ORD) D:ORN>0
  1. .. D:+PSOLST(ORN)=52 PROCESS
  1. .. S (PSOQUIT,PSORENW("DFLG"),POERR,POERR("DFLG"),PSORX("DFLG"))=0
  1. I '$G(PSOOELSE) S VALMBCK="" G SELQ
  1. S VALMBCK="R"
  1. D ^PSOBUILD,BLD^PSOORUT1 K DIR,DIRUT,DTOUT,DUOUT,LST,ORD,IEN,ORN,RPH,ST,REFL,REF,PSOACT,ORSV,PSORNW,PSORENW,PSONO,PSOCO,PSOCU,PSODIR,DSMSG,SPEED,PSORENW,PSOOELSE,PSOOPT,PSORX("FILL DATE"),PSORX("ISSUE DATE"),PSOID,PSOMSG,PSORX("DFLG"),PSOQTY
  1. SELQ ;
  1. K PSORNSPD,RTE,DRET,PRC,PHI,PSOSPRNW,X,PSOSKIP,PSOLCNT,PSOSTA
  1. S X=PSODFN_";DPT(" D ULK^ORX2,UL^PSSLOCK(PSODFN),CLEAN^PSOVER1
  1. Q
  1. ;
  1. RXCS(RXIEN) ; Return the CS Federal Schedule associated with Rx# RXIEN
  1. N DRGIEN,PSOY
  1. S DRGIEN=+$$GET1^DIQ(52,RXIEN,6,"I")
  1. Q $$DRGCS(DRGIEN)
  1. ;
  1. DRGCS(DRGIEN) ; Return the CS Federal Schedule associated with Drug File entry DRGIEN
  1. N DRGCS
  1. Q:'$G(DRGIEN) ""
  1. S DRGCS=$$GET1^DIQ(50,+$G(DRGIEN),3)
  1. Q DRGCS
  1. ;
  1. PROCESS ; Process one order at a time
  1. N PSORXIEN,PSOCHECK,MAXNUMRF
  1. S PSORXIEN=+$P($G(PSOLST(ORN)),"^",2)
  1. ;
  1. I $$LMREJ^PSOREJU1(PSORXIEN) D K DIR,PSOMSG D PAUSE^VALM1 Q
  1. . W $C(7),!!,"Rx# "_$$GET1^DIQ(52,PSORXIEN,.01)_" has OPEN/UNRESOLVED 3rd Party Payer Rejects!"
  1. I $$TITRX^PSOUTL(PSORXIEN)="t" D K DIR,PSOMSG D PAUSE^VALM1 Q
  1. . W $C(7),!!,"Rx# "_$$GET1^DIQ(52,PSORXIEN,.01)_" is marked as 'Titration Rx' and cannot be renewed."
  1. ; Checking whether the Provider still qualifies as prescriber for the renewed Rx
  1. S PROVIEN=$S($G(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:+$$GET1^DIQ(52,PSORXIEN,4,"I"))
  1. S PSOCHECK=$$CHKRXPRV^PSOUTIL(PSORXIEN,PROVIEN)
  1. I 'PSOCHECK,(PSOCHECK'["DEA#"),(PSOCHECK'["Federal Schedule") D K DIR,PSOMSG D PAUSE^VALM1 Q
  1. . W $C(7),!!,"Rx# "_$$GET1^DIQ(52,PSORXIEN,.01)_" - "_$P(PSOCHECK,"^",3)
  1. I $$CSRX^PSOUTL(PSORXIEN)!'PSOCHECK D ; 731 - Use $$CSRX^PSOUTL instead of $$RXCS^PSORENW4
  1. . N PSODRUG,PSOY,PSODRIEN D FULL^VALM1
  1. . S PSODRIEN=+$$GET1^DIQ(52,PSORXIEN,6,"I"),PSOY(0)=$G(^PSDRUG(PSODRIEN,0)),PSOY=PSODRIEN
  1. . S PSORX("CS")=$$DRGCS(PSODRIEN)
  1. . D SET^PSODRG S PSORENW("DEA")=$$SLDEA^PSODIR(PROVIEN,.PSORX,$$RXDEA^PSOUTIL(+$G(PSORXIEN)),PSODRIEN)
  1. . I $G(PSORENW("DEA"))="" S PSOCHECK="0^No valid DEA# selected^No valid DEA# selected"
  1. . ;N DIR S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR ; 731 - Remove extra prompt
  1. . Q:$G(PSORENW("DEA"))=""
  1. . S PSOCHECK=1
  1. I 'PSOCHECK D K DIR,PSOMSG D PAUSE^VALM1 Q
  1. . W $C(7),!!,"Rx# "_$$GET1^DIQ(52,PSORXIEN,.01)_" - "_$P(PSOCHECK,"^",3)
  1. ; Checking the Maximum Number of Refills Allowed
  1. S MAXNUMRF=$$MAXNUMRF^PSOUTIL(+$$GET1^DIQ(52,PSORXIEN,6,"I"),+$G(PSORENW("DAYS SUPPLY")),+$G(PSORENW("PATIENT STATUS")),.CLOZPAT)
  1. I PSORENW("# OF REFILLS")>MAXNUMRF D K DIR,PSOMSG D PAUSE^VALM1 Q
  1. . W $C(7),!!,"Rx# "_$$GET1^DIQ(52,PSORXIEN,.01)_" - # of Refills requested exceeds maximum allowed ("_MAXNUMRF_") for this Rx"
  1. ; PSO*7*508 - check if the Rx is an eRx. If so, inform the user and ask to proceed.
  1. N ERXORN,ERXIEN,ERXPROC S ERXORN=$$GET1^DIQ(52,$P(PSOLST(ORN),U,2),39.3)
  1. S ERXIEN=$$CHKERX^PSOERXU1(ERXORN)
  1. I ERXIEN S ERXPROC=$$PROVPMT^PSOERXU1(ERXIEN) Q:'ERXPROC
  1. ; PSO*7*508 - end
  1. I $$CSRX^PSOUTL(PSORXIEN),$$FMADD^XLFDT($G(PSORENW("ISSUE DATE")),180)<DT D K DIR,PSOMSG D PAUSE^VALM1 Q
  1. . W $C(7),!!,"Rx# "_$$GET1^DIQ(52,PSORXIEN,.01)_" - Rx is for a CS Drug and the Issue Date entered ("_$$FMTE^XLFDT(PSORENW("ISSUE DATE"))_") is",!,"greater than 6 months."
  1. ; Checking if Rx is locked by Another person
  1. D PSOL^PSSLOCK(PSORXIEN) I '$G(PSOMSG) W $C(7),!!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing Rx "_$P(^PSRX(PSORXIEN,0),"^")),! K DIR,PSOMSG D PAUSE^VALM1 Q
  1. K RET,DRET,PRC,PHI S PSORENW("OIRXN")=PSORXIEN,PSOFROM="NEW"
  1. S PSORENW("RX0")=^PSRX(PSORENW("OIRXN"),0),PSORENW("RX2")=^(2),PSORENW("RX3")=^(3),PSORENW("STA")=^("STA"),PSORENW("TN")=$G(^("TN")),SIGOK=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^",2)
  1. I SIGOK F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
  1. S PSOIBOLD=$G(PSORENW("OIRXN")) D SETIB^PSORENW1
  1. I '$G(PSORENW("PROVIDER")) D
  1. .S PSORENW("PROVIDER")=$P(PSORENW("RX0"),"^",4)
  1. .S:$P(PSORENW("RX3"),"^",3) PSORENW("COSIGNING PROVIDER")=$P(PSORENW("RX3"),"^",3)
  1. S PSORX("PROVIDER NAME")=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^")
  1. I '$G(PSORENW("CLINIC")) S PSORENW("CLINIC")=$P(PSORENW("RX0"),"^",5)
  1. S PSORENW("REMARKS")="RENEWED FROM RX # "_$P(PSORENW("RX0"),"^")
  1. S PSORENW("SIG")=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
  1. S PSORENW("PSODFN")=$P(PSORENW("RX0"),"^",2)
  1. S PSORENW("ORX #")=$P(PSORENW("RX0"),"^")
  1. S PSORENW("DRUG IEN")=$P(PSORENW("RX0"),"^",6)
  1. S PSORENW("QTY")=$P(PSORENW("RX0"),"^",7)
  1. S PSORENW("INS")=$S($G(PSORENW("ENT"))]"":PSORENW("ENT"),1:$G(^PSRX(PSORENW("OIRXN"),"INS")))
  1. S:$G(PSORENW("ENT"))']"" PSORENW("ENT")=0
  1. N I F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSORENW("OIRXN"),6,I,0) D
  1. .S PSORENW("ENT")=PSORENW("ENT")+1,PSORENW("DOSE",PSORENW("ENT"))=$P(DOSE,"^")
  1. .S PSORENW("UNITS",PSORENW("ENT"))=$P(DOSE,"^",3),PSORENW("DOSE ORDERED",PSORENW("ENT"))=$P(DOSE,"^",2),PSORENW("ROUTE",PSORENW("ENT"))=$P(DOSE,"^",7)
  1. .S PSORENW("SCHEDULE",PSORENW("ENT"))=$P(DOSE,"^",8),PSORENW("DURATION",PSORENW("ENT"))=$P(DOSE,"^",5),PSORENW("CONJUNCTION",PSORENW("ENT"))=$P(DOSE,"^",6)
  1. .S PSORENW("NOUN",PSORENW("ENT"))=$P(DOSE,"^",4),PSORENW("VERB",PSORENW("ENT"))=$P(DOSE,"^",9)
  1. .I $G(^PSRX(PSORENW("OIRXN"),6,I,1))]"" S PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
  1. .K DOSE
  1. I $P($G(^PSDRUG(PSORENW("DRUG IEN"),"CLOZ1")),"^")="PSOCLO1" N PSON S PSON=0 D I PSON K PSON D POZ,KLIB^PSORENW1 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q
  1. . I '$L($P(^VA(200,PSORENW("PROVIDER"),"PS"),"^",2)),'$L($P(^VA(200,PSORENW("PROVIDER"),"PS"),"^",3)) D Q
  1. . . S PSON=1 W $C(7),!!,"Only providers with DEA# or a VA# can write prescriptions for clozapine.",!
  1. . I '$D(^XUSEC("YSCL AUTHORIZED",PSORENW("PROVIDER"))) D
  1. . . S PSON=1 W $C(7),!!,$$CLKEYWRN^PSOCLUTL,!
  1. I $G(PSORNW("MAIL/WINDOW"))]"" S PSORENW("MAIL/WINDOW")=PSORNW("MAIL/WINDOW")
  1. I $O(^PSRX(PSORENW("OIRXN"),"PI",0)) D K T
  1. .S PHI=^PSRX(PSORENW("OIRXN"),"PI",0),T=0
  1. .F S T=$O(^PSRX(PSORENW("OIRXN"),"PI",T)) Q:'T S PHI(T)=^PSRX(PSORENW("OIRXN"),"PI",T,0)
  1. S PSORENW("MAIL EXEMPTION")=$$GET1^DIQ(52,PSORXIEN,100.2,"I") ;p753
  1. W !!,"Now Renewing Rx # "_PSORENW("ORX #")_" Drug: "_$P($G(^PSDRUG(+$G(PSORENW("DRUG IEN")),0)),"^"),!
  1. I '$P($G(^PSDRUG($P(PSORENW("RX0"),"^",6),2)),"^") D G:$G(PSORENW("DFLG")) PROCESSX
  1. .I $P($G(^PSRX(PSORENW("OIRXN"),"OR1")),"^") S PSODRUG("OI")=$P(^PSRX(PSORENW("OIRXN"),"OR1"),"^"),PSODRUG("OIN")=$P(^PS(50.7,+^("OR1"),0),"^") Q
  1. .W !!,"Cannot Renew!! No Pharmacy Orderable Item!" S VALMSG="Cannot Renew!! No Pharmacy Orderable Item!",PSORX("DFLG")=1
  1. D POZ
  1. D CHECK^PSORENW0 G:PSORENW("DFLG") PROCESSX
  1. D FILDATE^PSORENW0
  1. D DRUG^PSORENW0 G:PSORENW("DFLG") PROCESSX
  1. D RXN^PSORENW0 G:PSORENW("DFLG") PROCESSX
  1. D STOP^PSORENW1
  1. DSPL K PSOEDT,PSOLM,BBFLG,BBRX,BINGCRT,BINGRTE S PSDY=PSORENW("DAYS SUPPLY"),PSRF=PSORENW("# OF REFILLS")
  1. F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S PSODIR("CS")=1
  1. N MXRFLS
  1. S MXRFLS=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSORENW("DAYS SUPPLY")),+$P(^PSRX(PSORENW("OIRXN"),0),"^",3),.CLOZPAT)
  1. I MXRFLS<PSORENW("# OF REFILLS") S PSORENW("# OF REFILLS")=MXRFLS
  1. D DSPLY^PSORENW3 G:PSORENW("DFLG") PROCESSX
  1. D:$D(^XUSEC("PSORPH",DUZ))!('$P(PSOPAR,"^",2)) VER1^PSOORNE4(.PSORENW) G:PSORENW("DFLG")=1 PROCESSX
  1. I $G(PSOQTY) D QTY^PSODIR1(.PSORENW) G:PSORENW("DFLG")=1 PROCESSX
  1. D EN^PSORN52(.PSORENW)
  1. D RNPSOSD^PSOUTIL
  1. D CAN^PSORENW0,DCORD^PSONEW2
  1. S PSORENW("# OF REFILLS")=PSRF K PSDY,PSRF,PSODIR("CS"),DEA,PSORENW("ENT")
  1. S BBRN="",BBRN1=$O(^PSRX("B",PSORENW("NRX #"),BBRN)) I $P($G(^PSRX(BBRN1,0)),"^",11)["W" S BINGCRT="Y",BINGRTE="W",BBFLG=1,BBRX(1)=$G(BBRX(1))_BBRN1_","
  1. PROCESSX ;
  1. I PSORENW("DFLG") D
  1. .K PHI,PRC,PSODRUG,SIG,PSORXED,SIGOK
  1. .K PSORENW("DOSE"),PSORENW("DURATION"),PSORENW("DRUG IEN"),PSORENW("ENT"),PSORENW("INS"),PSORENW("NOUN"),PSORENW("ROUTE"),PSORENW("SCHEDULE"),PSORENW("SIG"),PSORENW("VERB"),PSORENW("UNITS")
  1. .I '$G(POERR) W !,$C(7),"Rx NOT RENEWED. RENEWED RX DELETED",! S POERR("DFLG")=1 D CLEAN^PSOVER1,POZ
  1. K PSORDLOK I PSORENW("DFLG") S PSORDLOK=1
  1. D:$G(PSORENW("OLD FILL DATE"))]"" SUSDATEK^PSOUTIL(.PSORENW)
  1. K BBRN,BBRN1,PSODRUG,PSORX("PROVIDER NAME"),PSORX("CLINIC")
  1. K PSOEDT,PSOLM S:$G(PSORENW("FROM"))="" (PSORENW("DFLG"),PSORENW("QFLG"))=0
  1. I $G(PSORDLOK) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
  1. D KLIB^PSORENW1
  1. K PSORDLOK
  1. S RXN=$O(^TMP("PSORXN",$J,0)) I RXN N ZRXN S ZRXN=RXN D
  1. .S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3))
  1. .I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS",$P(RXN1,"^",4))
  1. .;saves drug allergy order chks pso*7*390
  1. .I $D(^TMP("PSODAOC",$J,"ALLERGY")) D
  1. ..I $G(PSORX("DFLG"))!$G(PSORENW("DFLG")) K ^TMP("PSODAOC",$J) Q
  1. ..S RXN=ZRXN,PSODAOC="Rx Backdoor "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"SPEED RENEW Order Acceptance_OP"
  1. ..S PSOARENW=1 D DAOC^PSONEW K PSOARENW
  1. K ZRXN,RXN,RXN1,^TMP("PSORXN",$J),^TMP("PSODAOC",$J)
  1. Q
  1. INIT ;
  1. D ASK Q:PSORENW("DFLG")
  1. D NOORE^PSONEW(.PSORENW) Q:PSORENW("DFLG")
  1. Q
  1. ASK ;upfront questions
  1. W !! D ISSDT^PSODIR2(.PSORENW) Q:PSORENW("DFLG") S PSORENW("ISSUE DATE")=PSOID
  1. D MW^PSODIR2(.PSORENW) Q:PSORENW("DFLG")
  1. D FILLDT^PSODIR2(.PSORENW) K PSONEW("DAYS SUPPLY"),PSONEW("# OF REFILLS") Q:PSORENW("DFLG")
  1. S PSORNW("FILL DATE")=PSORENW("FILL DATE")
  1. D PTSTAT^PSODIR1(.PSORENW) Q:PSORENW("DFLG")
  1. D DAYS^PSODIR1(.PSORENW) Q:PSORENW("DFLG")
  1. S PSODRUG("DEA")=0 D REFILL^PSODIR1(.PSORENW) K PSODRUG("DEA") Q:PSORENW("DFLG")
  1. K DIR,DIRUT S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to edit Renewed Rx(s) QTY " D ^DIR I $D(DIRUT) S PSORENW("DFLG")=1 K DIR,DIRUT Q
  1. S PSOQTY=Y K DIR,DIRUT,Y
  1. D CLINIC^PSODIR2(.PSORENW) Q:PSORENW("DFLG")
  1. D PROV^PSODIR(.PSORENW) S:PSORENW("DFLG") PSORENW("DFLG")=0
  1. S PSORENW("MAIL EXEMPTION")="" ;p753
  1. Q
  1. ;
  1. POZ ;
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DTOUT
  1. Q
  1. ;