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