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

PSODIR1.m

Go to the documentation of this file.
  1. PSODIR1 ;IHS/DSD - ASKS DATA FOR RX ORDER ENTRY CONT. ;7 Jan 2020 16:58:09
  1. ;;7.0;OUTPATIENT PHARMACY;**23,46,78,102,121,131,146,166,184,222,268,206,266,340,391,444,446,505,543,457,574,612,686,700,769**;DEC 1997;Build 26
  1. ;External reference ^PS(55 supported by DBIA 2228
  1. ;External reference ^PSDRUG( supported by DBIA 221
  1. ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
  1. ;External reference $$HTFM^XLFDT supported by DBIA 10103
  1. ; Reference to $$ISCLOZ^PSJCLOZ in ICR #7176
  1. ;
  1. PTSTAT(PSODIR) ;
  1. PTSTATEN K DIC,DR,DIE S PSODIR("FIELD")=0
  1. I $G(PSOTPBFG),$G(PSOFROM)="NEW" K PSORX("PATIENT STATUS"),PSODIR("PATIENT STATUS") N PSOFNDRX,PSOFNDFL,PSOFNDPS D
  1. . S PSOFNDFL=0 F PSOFNDPS=0:0 S PSOFNDPS=$O(^PS(53,PSOFNDPS)) Q:'PSOFNDPS!(PSOFNDFL) D
  1. .. S PSOFNDRX=$P($G(^PS(53,PSOFNDPS,0)),"^") S PSOFNDRX=$$UP^XLFSTR(PSOFNDRX) I PSOFNDRX="NON-VA" S PSOFNDFL=1 S (PSORX("PATIENT STATUS"),DIC("B"))=$P($G(^PS(53,PSOFNDPS,0)),"^")
  1. I $G(PSOTPBFG),$G(PSOFROM)="NEW",$G(PSORX("PATIENT STATUS"))="" W !,"Could not find a 'NON-VA' Patient Status in the RX PATIENT STATUS file (#53)!" D PSTPB D S PSODIR("DFLG")=1 G PTSTATX
  1. . K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. I $G(PSOTPBFG),$G(PSOFROM)="NEW" G TPBB
  1. N PSOX
  1. S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(53,PSOX,0)),"^"),DIC("B")=PSORX("PATIENT STATUS")
  1. S:$G(PSODIR("PATIENT STATUS"))]"" DIC("B")=PSODIR("PATIENT STATUS")
  1. TPBB ;
  1. D ELIG^VADPT W !,"Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:"")
  1. S N=0 F S N=$O(VAEL(1,N)) Q:'N W !,?10,$P(VAEL(1,N),"^",2)
  1. S DIC("A")="RX PATIENT STATUS: "
  1. S DIC(0)="QEAMZ",DIC=53 D ^DIC K DIC
  1. I $G(PSOTPBFG),$G(PSOFROM)="NEW" N PSOPSDIR,PSOFNDZZ,PSOPSUPA S (PSOPSDIR,PSOPSUPA)=0 D I PSOPSDIR S:PSOPSUPA PSODIR("DFLG")=1 G:PSOPSUPA PTSTATX W ! D PSTPB G PTSTATEN
  1. . I Y'>0!($D(DTOUT))!($D(DUOUT)) S (PSOPSDIR,PSOPSUPA)=1 Q
  1. . S (PSODIR("PATIENT STATUS"),PSORX("PATIENT STATUS"))=+Y,PSODIR("PTST NODE")=$G(Y(0))
  1. . S PSOFNDZZ=$P($G(^PS(53,+Y,0)),"^") S PSOFNDZZ=$$UP^XLFSTR(PSOFNDZZ) I PSOFNDZZ'="NON-VA" S PSOPSDIR=1 K PSODIR("PATIENT STATUS"),PSORX("PATIENT STATUS"),PSODIR("PTST NODE")
  1. I $G(PSOTPBFG),$G(PSOFROM)="NEW" G TPBSC
  1. I X[U,$L(X)>1 D:'$G(PSOEDIT) JUMP G PTSTATX
  1. I $D(DUOUT)!$D(DTOUT) S PSODIR("DFLG")=1 G PTSTATX
  1. I Y=-1 W $C(7)," Required" G PTSTATEN
  1. N PSOFNDX,PSOFNDXY,PSOFNDXX,PSOFNDYY
  1. S PSOFNDXY=$G(Y),PSOFNDYY=$G(Y(0))
  1. I '$G(PSOTPBFG),$G(PSOFROM)="NEW" S PSOFNDX=$P($G(^PS(53,+Y,0)),"^") S PSOFNDXX=$$UP^XLFSTR(PSOFNDX) I PSOFNDXX="NON-VA" K PSOFNDX,PSOFNDXY,PSOFNDYY,PSOFNDXX,Y W !!,"Cannot select 'NON-VA' Rx Patient Status!",! G PTSTATEN
  1. S Y=$G(PSOFNDXY),Y(0)=$G(PSOFNDYY)
  1. K PSOFNDXY,PSOFNDYY,PSOFNDX,PSOFNDXX
  1. S (PSODIR("PATIENT STATUS"),PSORX("PATIENT STATUS"))=+Y
  1. S PSODIR("PTST NODE")=$G(Y(0))
  1. TPBSC ;
  1. I $G(PSOFDR),$P($G(OR0),"^",17)="C" G PTSTATX
  1. L +^PS(55,PSODFN):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T G PTSTATX
  1. S DIE="55",DR="3////"_+Y,DA=PSODFN D ^DIE K DIE,DA,D0
  1. L -^PS(55,PSODFN)
  1. PTSTATX ;
  1. K DTOUT,DUOUT,X,Y,DA Q
  1. ;
  1. SIG(PSODIR) ;
  1. I $G(PSOFDR),$G(PSODIR("SIG"))']"" D SIGOK G:$G(SIGOK)!($G(PSODIR("DFLG"))) SIGX
  1. K DIR,DIC
  1. S DIR(0)="52,10"
  1. S:$G(PSODRUG("SIG"))]"" DIR("B")=PSODRUG("SIG")
  1. S:$G(PSODIR("SIG"))]"" DIR("B")=PSODIR("SIG")
  1. D DIR G:PSODIR("DFLG")!PSODIR("FIELD") SIGX
  1. S PSODIR("SIG")=Y,SIGOK=0 K SIG
  1. SIGX ;
  1. K X,Y Q
  1. ;
  1. QTY(PSODIR) ;
  1. QTYA K DIR,DIC N RFL,RXIEN
  1. I $G(CLOZPAT)=1 S DIR("A",1)="Patient Eligible for 14 day supply or 7 day supply with 1 refill"
  1. I $G(CLOZPAT)=2 S DIR("A",1)="Patient Eligible 28 day supply or 14 day supply with 1 refill or 7 day supply with 3 refill"
  1. S DIR(0)="52,7" S:$G(PSODRUG("IEN")) DIR("A")="QTY ( "_$G(PSODRUG("UNIT"))_" ) "_$S($P($G(^PSDRUG(+PSODRUG("IEN"),5)),"^")]"":$P(^PSDRUG(+PSODRUG("IEN"),5),"^"),1:"")
  1. K QTYHLD I $G(PSODIR("QTY"))]"" S QTYHLD=PSODIR("QTY") K PSODIR("QTY")
  1. D:'$G(PSOQTY) QTY^PSOSIG(.PSODIR)
  1. I '$G(SPEED),$G(QTYHLD),'$G(PSODIR("QTY")) S PSODIR("QTY")=QTYHLD
  1. K QTYHLD K:'$G(PSODIR("QTY")) PSODIR("QTY")
  1. I $G(SPEED),$G(PSODIR("QTY"))']"" S PSODIR("QTY")=$P(^PSRX(PSORENW("OIRXN"),0),"^",7)
  1. S:$G(PSODIR("QTY"))]"" DIR("B")=PSODIR("QTY")
  1. ; JCH - PSO*7.0*612 - BEGIN
  1. I $G(CLOZPAT)>0 I $D(^XTMP("PSJ4D-"_+$G(PSODFN)))!$D(^XTMP("PSO4D-"_+$G(PSODFN))) K DIR("A",1)
  1. ; JCH - PSO*7.0*612 - END
  1. D DIR
  1. ;/BLB/ PSO*7.0*505 ;MODIFIED QTY CHECK TO ALLOW LEADING ZEROS
  1. I Y[".",$P(Y,".")<1 S Y="0"_"."_$P(Y,".",2)
  1. G:PSODIR("DFLG")!PSODIR("FIELD") QTYX
  1. I $G(Y),$G(PSODRUG("MAXDOSE"))]"",$G(PSODIR("DAYS SUPPLY")),(Y/+PSODIR("DAYS SUPPLY")>PSODRUG("MAXDOSE")) D G:$G(PSODIR("DFLG")) QTYX G QTYA
  1. . W !,$C(7)," Greater than Maximum dose of "_PSODRUG("MAXDOSE")_" per day" D DAYSEN
  1. I $G(PSOFDR),$P($G(OR0),"^",24),$G(PSODIR("QTY")),+Y>$G(PSODIR("QTY")) D G QTYX
  1. . W !!,"Digitally Signed Order - QTY cannot be increased",!
  1. . N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
  1. S PSODIR("QTY")=Y
  1. ;
  1. QTYX ;
  1. K X,Y Q
  1. ;
  1. COPIES(PSODIR) ;
  1. K DIR,DIC
  1. S DIR(0)="52,10.6"
  1. S DIR("B")=$S($G(PSODIR("COPIES"))]"":PSODIR("COPIES"),1:1)
  1. D DIR G:PSODIR("DFLG")!PSODIR("FIELD") COPIESX
  1. S PSODIR("COPIES")=Y
  1. COPIESX ;
  1. K X,Y Q
  1. ;
  1. DAYS(PSODIR) ;
  1. DAYSEN K DIR,DIC N PSORFLS
  1. ;PSO*7*266
  1. N S2DS,MXDAYSUP,DFDAYSUP,PSDAYSUP,CSDRUG,NEWTOTDS,PSOREGN S S2DS=0
  1. S MXDAYSUP=90,CSDRUG=0
  1. I $D(PSODRUG("IEN")) D
  1. . S MXDAYSUP=$$MXDAYSUP^PSSUTIL1(PSODRUG("IEN"))
  1. . S S2DS=$$CSDS^PSOSIGDS(PSODRUG("IEN")) I S2DS,$P($G(PSODIR("PTST NODE")),"^",3)>29 S S2DS=30
  1. . S PSORFLS=$S($G(PSODIR("# OF REFILLS")):PSODIR("# OF REFILLS"),1:$P($G(PSODIR("RX0")),"^",9))
  1. . I '$D(PSODRUG("DEA")) S PSODRUG("DEA")=$$GET1^DIQ(50,PSODRUG("IEN"),3,"")
  1. . I (PSODRUG("DEA")["2")!(PSODRUG("DEA")["3")!(PSODRUG("DEA")["4")!(PSODRUG("DEA")["5") S CSDRUG=1
  1. S PSOREGN="" ;p457
  1. I $$ISCLOZ^PSJCLOZ(,,,,$G(PSODRUG("IEN"))) S PSOREGN=$$GET1^DIQ(55,PSODFN,53) ;p457
  1. ;S PSOREGN=$$GET1^DIQ(55,PSODFN,53) p457 commented out
  1. S PSDAYSUP=$S(PSOREGN?1U6N!$D(^TMP($J,"CLOZFLG",PSODFN)):4,$G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,1:MXDAYSUP)
  1. I (PSOREGN?2U5N)&($$GET1^DIQ(50,+$G(PSODRUG("IEN")),17.5)="PSOCLO1") D
  1. . I $P($G(^XTMP("PSO4D-"_PSODFN,"PSOYS")),"^",4)'>0,($P($G(^XTMP("PSO4D-"_PSODFN,0)),"^",1))>$$HTFM^XLFDT($H,1) D
  1. .. ;Begin: JCH - PSO*7*612
  1. .. N PSOCLZN,PSOYSIEN,PSOCLODT S PSOCLZN=$$GET1^DIQ(55,PSODFN,53)
  1. .. I PSOCLZN?2U5N S PSOYSIEN=$$FIND1^DIC(603.01,,"Q",PSOCLZN,"B") I PSOYSIEN S PSOCLODT=$$GET1^DIQ(603.01,+PSOYSIEN,3,"I") I (PSOCLODT=$$DT^XLFDT) Q
  1. .. ;End: JCH - PSO*7*612
  1. .. S PSDAYSUP=4 ; Special condition local override if no ANC results
  1. S DIR(0)="N^1:"_PSDAYSUP
  1. S DFDAYSUP=$S($D(CLOZPAT)&('$G(PSODIR("DAYS SUPPLY"))):7,$G(PSODIR("DAYS SUPPLY"))]"":PSODIR("DAYS SUPPLY"),S2DS>1:S2DS,$P($G(PSODIR("PTST NODE")),"^",3):$P(PSODIR("PTST NODE"),"^",3),1:30)
  1. I DFDAYSUP>MXDAYSUP D S DFDAYSUP=MXDAYSUP
  1. . W:$G(PSODIR("DAYS SUPPLY")) !!,$C(7),"Invalid DAYS SUPPLY value (",DFDAYSUP,"), resetting it to ",MXDAYSUP," (maximum allowed).",!
  1. S DIR("B")=DFDAYSUP
  1. S DIR("A")="DAYS SUPPLY",DIR("?")="Enter a whole number between 1 and "_PSDAYSUP
  1. D DIR G:PSODIR("DFLG")!PSODIR("FIELD") DAYSX
  1. I $G(Y),$G(PSODRUG("MAXDOSE"))]"",$G(PSODIR("QTY"))]"",(+PSODIR("QTY")/Y>PSODRUG("MAXDOSE")) D G DAYSEN
  1. .W !,$C(7)," Greater than Maximum dose of "_PSODRUG("MAXDOSE")_" per day"
  1. I $G(PSOFDR),$P($G(OR0),"^",24),$G(PSODIR("DAYS SUPPLY")),+Y>$G(PSODIR("DAYS SUPPLY")) D G DAYSX
  1. . W !!,"Digitally Signed Order - Days Supply cannot be increased",!
  1. . N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
  1. I $G(PSONEW("FLD"))=8,PSODIR("DAYS SUPPLY")=Y Q
  1. S:$G(PSODIR("DAYS SUPPLY")) PSODIR("DAYS SUPPLY OLD")=PSODIR("DAYS SUPPLY")
  1. S PSODIR("DAYS SUPPLY")=Y
  1. ; Checking the # Of Refills field value after the Days Supply field was edited
  1. I $D(PSODRUG("IEN")),$G(Y),$G(Y)>$S(PSORFLS<4:90,PSORFLS<6:89,PSORFLS<12:60,1:0) D
  1. . N PTST
  1. . S PTST=+$G(PSODIR("PATIENT STATUS")) S:'PTST PTST=$P($G(PSODIR("RX0")),"^",3)
  1. . I 'PTST,$G(PSODFN) S PTST=+$G(^PS(55,PSODFN,"PS"))
  1. . I PSORFLS>$$MAXNUMRF^PSOUTIL(PSODRUG("IEN"),Y,PTST,.CLOZPAT) D
  1. .. W !,$C(7),"Invalid number of REFILLS for amount of DAYS SUPPLY.",!,"REFILL EDIT FORCED." D REFILL(.PSODIR)
  1. .. S PSODIR("FLD",9)=PSODIR("# OF REFILLS")
  1. S:$G(CLOZPAT)=0 (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=0
  1. D:$G(CLOZPAT)=2
  1. . S:PSODIR("DAYS SUPPLY")=28 (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=0
  1. . S:PSODIR("DAYS SUPPLY")=14 (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=1
  1. . S:PSODIR("DAYS SUPPLY")=7 (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=3
  1. D:$G(CLOZPAT)=1
  1. . S:PSODIR("DAYS SUPPLY")=14 (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=0
  1. . S:PSODIR("DAYS SUPPLY")=7 (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=1
  1. K QTYHLD S:$G(PSODIR("QTY")) QTYHLD=PSODIR("QTY") D QTY^PSOSIG(.PSODIR)
  1. I $G(QTYHLD),'$G(PSODIR("QTY")) S PSODIR("QTY")=QTYHLD
  1. K QTYHLD K:'$G(PSODIR("QTY")) PSODIR("QTY")
  1. I $$ISCLOZ^PSJCLOZ(,,,,$G(PSODRUG("IEN"))) D EXPDT^PSOCLO1(.PSODIR,.CLOZPAT)
  1. DAYSX ;
  1. K X,Y Q
  1. ;
  1. REFILL(PSODIR) ;
  1. N PSODAYS,PSOX
  1. S PSODAYS=+$G(PSODIR("DAYS SUPPLY"))
  1. ;Recalculating RFTT if it doesn't exist
  1. I '$G(PSONEW) D
  1. . N I I '$G(RFTT),$G(PSORXED("IRXN")) F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I S RFTT=$G(RFTT)+1
  1. ;
  1. I $G(PSODIR("PTST NODE"))="" D
  1. . N X,Y
  1. . S X=$G(PSODIR("PATIENT STATUS")) I 'X,$D(RX0) S X=$P(RX0,"^",3)
  1. . S DIC=53,DIC(0)="QXZ" D ^DIC K DIC
  1. . S:+Y PSODIR("PTST NODE")=$G(Y(0))
  1. . S:'$G(PSODIR("PATIENT STATUS")) PSODIR("PATIENT STATUS")=+Y
  1. S $P(PSODIR("PTST NODE"),"^",4)=+$P($G(PSODIR("PTST NODE")),"^",4)
  1. I $G(OR0) G REFOR
  1. K DIR,DIC,PSOX
  1. ; Controlled Substance
  1. S PSODIR("CS")=0
  1. I (PSODRUG("DEA")["2")!(PSODRUG("DEA")["3")!(PSODRUG("DEA")["4")!(PSODRUG("DEA")["5") D
  1. . S $P(PSODIR("CS"),"^")=1 S:(PSODRUG("DEA")["2") $P(PSODIR("CS"),"^",2)=1
  1. ;
  1. ; Retrieving the Maximum Number of Refills allowed
  1. S PSOX=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),PSODAYS,+$G(PSODIR("PATIENT STATUS")),.CLOZPAT)
  1. ;
  1. I '$D(CLOZPAT) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2) D G REFILLX
  1. . I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2)!'$O(^PSRX(+$G(PSODIR("IRXN")),1,0))!('$G(PSOLOKED)) D Q
  1. .. S VALMSG="No refills allowed on "_$S(PSODRUG("DEA")["F":"this drug.",1:"Narcotics.") W !,VALMSG,!
  1. .. S:$D(PSODIR("FIELD")) PSODIR("FIELD")=0 S PSODIR("# OF REFILLS")=0
  1. . ; reset refills to the # given
  1. . D RFRSET^PSODIR2
  1. ;
  1. I $P($G(PSODIR("CS")),"^",2)=1 W !,"No refills allowed on Schedule 2 drugs...",! S:$D(PSODIR("FIELD")) PSODIR("FIELD")=0 S PSODIR("# OF REFILLS")=0 G REFILLX
  1. ;
  1. ;/RBN - Integration of 457 start
  1. I $D(CLOZPAT) S PSOX=$S($G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=14):1,$G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=7):3,$G(CLOZPAT)=1&(PSODIR("DAYS SUPPLY")=7):1,1:0)
  1. ;/RBN - Integration of 457 end
  1. ;
  1. ;PSO*7*266 make sure PSOX is greater than RFTT
  1. S DIR(0)="N^"_$S($G(RFTT):RFTT,1:0)_":"_$S(+$G(RFTT)>PSOX:RFTT,1:PSOX),DIR("A")="# OF REFILLS"
  1. ;PSO*7*340 Correct Default Value
  1. S DIR("B")=$S($G(COPY)&('$G(PSOTITRX)):$G(PSODIR("# OF REFILLS")),$G(PSODIR("N# REF"))]"":PSODIR("N# REF"),$G(PSODIR("# OF REFILLS"))]"":PSODIR("# OF REFILLS"),$G(RFTT)>PSOX:RFTT,1:PSOX)
  1. S DIR("?",1)="Enter a whole number. The maximum number of refills is based on"
  1. S DIR("?")="the DAYS SUPPLY and the PATIENT STATUS fields."
  1. D DIR G:PSODIR("DFLG")!PSODIR("FIELD") REFILLX
  1. S (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=Y
  1. ;
  1. REFILLX ;
  1. S:$G(PSODIR("# OF REFILLS"))']"" PSODIR("# OF REFILLS")=$S($G(PSODIR("N# REF"))]"":PSODIR("N# REF"),1:PSOX)
  1. K X,Y,PSOX,DEA,PSOCS,RFTT ;PSO*7*340 Kill RFTT
  1. Q
  1. ;OERR CALL
  1. REFOR ;
  1. D REFOR^PSODIR3
  1. G REFILLX
  1. Q
  1. DIR ;
  1. S (PSODIR("FIELD"),PSODIR("DFLG"))=0
  1. G:$G(DIR(0))']"" DIRX
  1. D ^DIR K DIR,DIE,DIC,DA
  1. I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)),$L($G(X))'>1!(Y="") S PSODIR("DFLG")=1 G DIRX
  1. I $D(DIRUT)!($D(DIROUT)),$G(SPEED) S PSODIR("DFLG")=1 G DIRX
  1. I $E(X,1)=U S PSODIR("DFLG")=1 G DIRX ;p686
  1. I X[U,$L(X)>1 D JUMP
  1. DIRX ;
  1. K DIRUT,DTOUT,DUOUT,DIROUT Q
  1. ;
  1. JUMP ;
  1. I $G(PSOEDIT)!($G(OR0)) S PSODIR("DFLG")=1 Q
  1. S X=$P(X,"^",2),DIC="^DD(52,",DIC(0)="QM" D ^DIC K DIC
  1. I Y=-1 S PSODIR("FIELD")=PSODIR("FLD") G JUMPX
  1. I $G(PSONEW1)=0 D JUMP^PSONEW1 G JUMPX
  1. I $G(PSOREF1)=0 D JUMP^PSOREF1 G JUMPX
  1. I $G(PSONEW3)=0 D JUMP^PSONEW3 G JUMPX
  1. I $G(PSORENW3)=0 D JUMP^PSORENW3 G JUMPX
  1. JUMPX ;
  1. S X="^"_X Q
  1. ;
  1. SIGOK ;review and decide on oerr sig
  1. I '$O(SIG(0)) S SIGOK=0 Q
  1. K SIGOK W !,"SIG: "
  1. F SIG=0:0 S SIG=$O(SIG(SIG)) W SIG(SIG)_" ",!?5 Q:'$O(SIG(SIG))
  1. K DIR,DIRUT,DUOUT,DTOUT S DIR("B")="YES",DIR(0)="Y",DIR("A")="Is this SIG correct" D ^DIR K DIR I $D(DIRUT) S PSODIR("DFLG")=1 K DIRUT,DUOUT,DTOUT Q
  1. S SIGOK=Y I Y K PSODIR("SIG")
  1. Q
  1. PSTPB ;
  1. W !,"New orders entered through this option must have a Patient Status of 'NON-VA'!",!
  1. Q
  1. ;