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

PSODOSUN.m

Go to the documentation of this file.
  1. PSODOSUN ;BIR/RTR - Dose Check Utility routine ;11/18/08
  1. ;;7.0;OUTPATIENT PHARMACY;**251,379,372,416,436,402,500,518**;DEC 1997;Build 3
  1. ;
  1. DOSE() ;Write Dose output for renew, finish, copy, etc.
  1. N PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,PSODLFLG,PSODLALZ,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1,PSODLOFF
  1. N PSODLNN1,PSODLERR,PSODLERX,PSODLQT,PSOCPXG,PSOCPXRR,PSODLEXR,PSODELNX,PSODLECT,PSOCPXF,PSODTYPE,PSOCPXC,PSOLASTS,PSOQTOUT,PSOEDOUT,PSODSEQ
  1. N PSOSIGC,PSOINTRO,PSOEXCPT,PSOERROR
  1. S (PSODLERF,PSODLERZ,PSODLALZ,PSODLINS,PSODLINR,PSODLINX,PSODLERR,PSODLQT,PSOCPXG,PSOCPXF,PSOLASTS,PSOQTOUT,PSOEDOUT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0,PSODTYPE="N",PSOCPXC=1
  1. I $G(PSORXED)&$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
  1. I $G(PSOCPXB)<4 S PSOCPXC=0
  1. W:$G(PSOEDIT)!$G(PSOCOPY)!($G(PSOFOERR)) @IOF I $P($G(^TMP($J,"PSOPDOSN","OUT",0)),"^")=-1 D S PSODLFLG=0,PSODLOFF=1 G END
  1. .D HD N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF D MESG
  1. .S X="Reason(s): "_$P(^TMP($J,"PSOPDOSN","OUT",0),"^",2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
  1. .S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D HD W:PSODELXF&('PSODLQT) ! D HD W:'PSODLQT " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S PSODELXF=1
  1. .K ^UTILITY($J,"W")
  1. ;PSOCPXB = Number of Dosing Seq
  1. S PSODLQT=0 K PSOCPXRR
  1. D EN^PSODOSU2
  1. END ;
  1. I $G(PSORX("DFLG")) Q 0
  1. I '$G(PSODLALZ),'$G(PSODLFLG),'$G(PSODLERR),'$G(PSODLOFF) Q 0
  1. I '$G(PSODLFLG) W !
  1. K PSODAILY,DIR,Y,PSODOSEX
  1. D PROMPT Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 1
  1. I '$G(PSODLINS)&('$G(PSODLINR))&('$G(PSODLINX)) Q 0
  1. I $D(^XUSEC("PSORPH",DUZ)) D I Y'=1!($D(DTOUT))!($D(DUOUT))!($G(PSRX("DFLG"))) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
  1. .S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR
  1. I '$G(PSODLINS)&'$G(PSODLINR)&('$G(PSODLINX)) Q 0
  1. I '$D(^XUSEC("PSORPH",DUZ)) Q 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
  1. W !!,"Do you want to Process or Cancel medication?" K DIR,Y S DIR("B")="P",DIR(0)="SA^1:PROCESS MEDICATION;0:CANCEL MEDICATION"
  1. S DIR("A")=$$GETGN^PSODOSUN(PSODRUG("IEN"))_": " K ^TMP($J,"PSODOSUN GN")
  1. S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'C' to Cancel Medication"
  1. D ^DIR K DIR
  1. I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
  1. ;need to know if user cancelled or not
  1. I Y=0 Q 3_"^"_$S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
  1. K PSODOSEX
  1. S PSOSIGC=0
  1. SIG1 ;
  1. D SIG^XUSESIG
  1. I 'PSOSIGC&($G(X1)="") D MSG1 S PSOSIGC=PSOSIGC+1 G SIG1
  1. I $G(X1)="" D MSG2 Q 1
  1. END2 ;
  1. I $G(PSORX("DFLG")) Q 0
  1. Q 2_"^"_$S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
  1. ;
  1. EVAL(PSODLINS,PSODLINR,PSODLINX) ;
  1. Q $S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
  1. ;
  1. DOSEX(PSODLXNT) ;Write Dose exceptions for order entry/edit
  1. N PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1
  1. N PSODLNN1,PSODLERX,PSODLQT,PSODELNX,PSODTYPE,PSODCONT,PSODSEQ,PSODOSX,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR
  1. W @IOF S (PSODLERF,PSODLERZ,PSODLINS,PSODLINR,PSODLINX,PSODLQT,PSODCONT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0,PSODTYPE="E"
  1. I $G(PSOEDDOS) Q:$G(PSORXED("CONJUNCTION",1))="" 0 ;don't show messages when simple order before accept of order during edits
  1. I PSOCPXB>3,$G(PSORXED)&$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
  1. I $P($G(^TMP($J,"PSOPDOSN","OUT",0)),"^")=-1 D S PSODLFLG=0,PSODLOFF=1 G ENDX
  1. .D HD N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF D MESG
  1. .S X="Reason(s): "_$P(^TMP($J,"PSOPDOSN","OUT",0),"^",2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
  1. .S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D HD W:PSODELXF&('PSODLQT) ! D HD W:'PSODLQT " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S PSODELXF=1
  1. .K ^UTILITY($J,"W")
  1. D EN^PSODOSU2
  1. ENDX ;
  1. S PSODOSX=1
  1. I $G(PSORX("DFLG")) Q 0
  1. K PSOCPXRR
  1. I '$G(PSODLALZ),'$G(PSODLFLG),'$G(PSODLERR),'$G(PSODLOFF) Q 0
  1. ;
  1. ;This "return to continue" occurs after the last dosing sequence for a complex order with 4 or more dosing sequences during an edit when finishing, placing a new order, copy or edit
  1. ;
  1. I '$G(PSOCKCON)&($G(PSOFOERR)) D I $G(PSOQTOUT) Q 0
  1. .Q:($G(PSODLFLG))&$D(^XUSEC("PSORPH",DUZ)) ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
  1. .D RETURN
  1. Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 1
  1. ;
  1. I '$G(PSOFOERR) D I $G(PSOQTOUT) Q 0
  1. .Q:$G(PSODLFLG)&$D(^XUSEC("PSORPH",DUZ))
  1. .I '$G(PSOEDIT) Q:$G(PSODOSNW)&'$G(PSOCPXD)&'$G(PSOCOPY)
  1. .Q:($G(PSOCOPY)!$G(PSOEDIT))&'$G(PSOCPXV)
  1. .Q:PSOCPXB>3&$G(PSOCPXV)
  1. .D RETURN
  1. Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 1
  1. ;
  1. I '$G(PSODLFLG) W !
  1. I '$D(^XUSEC("PSORPH",DUZ)),$G(PSODLINS)!($G(PSODLINR))!($G(PSODLINX)),$G(PSODLFLG) Q 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
  1. I 'PSODCONT Q:$G(PSOCPXV) 0
  1. I $G(PSODLBD4)&'$G(PSODLINS)&'$G(PSODLINR)&'$G(PSODLINX)&('$G(PSODLALZ)) S Y=1 G ENDX2
  1. K DIR,Y I $D(^XUSEC("PSORPH",DUZ)) S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
  1. ENDX2 ;
  1. K PSODOSEX
  1. W !
  1. Q 0
  1. DOSEZ() ;Write Dose output summary for complex orders
  1. I $G(PSOEDDOS) Q:$G(PSORXED("CONJUNCTION",1))="" 0 ;don't show messages when simple order before accept of order during edits
  1. N PSOCPXF,PSOCPXC,PSOCPXRR,PSOCPXG,PSODLESM,PSODELNX,PSOCPXH,PSODTYPE,PSOLASTS,PSOLASTD,PSOQTOUT,PSOEDOUT,PSODSEQ
  1. N PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1
  1. N PSODLNN1,PSODLERX,PSODLQT,PSODLEXR,PSODLECT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR
  1. I '$G(PSOTOF) W @IOF
  1. S (PSODLERF,PSODLERZ,PSODLINS,PSODLINR,PSODLINX,PSOCPXF,PSODLQT,PSOCPXH,PSOLASTS,PSOLASTD,PSOQTOUT,PSOEDOUT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0,PSODTYPE="C",PSOCPXC=1
  1. I $G(PSORX("EDIT"))!($G(PSORXED)&$G(PSOEDDOS))!($G(PSOCOPY)&$G(PSODLBD4)) S PSOEDOUT=1
  1. I PSOCPXB>3,$G(PSOEDOUT) S PSOCPXC=0
  1. ;I PSOCPXB>3,$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
  1. I $G(PSOCPXB)<4 S PSOCPXC=0
  1. Q:$G(PSOCPXB)<4&'$G(PSOFOERR)&('$G(PSODLFLG)) 0
  1. I $P($G(^TMP($J,"PSOPDOSN","OUT",0)),"^")=-1 S PSODLQT=1 D S PSODLFLG=0,PSODLOFF=1 G ENDZ
  1. .D:PSOCPXC HD W:'PSODLQT&(PSOCPXC) !! N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF D MESG
  1. .S X="Reason(s): "_$P(^TMP($J,"PSOPDOSN","OUT",0),"^",2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
  1. .S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D:PSOCPXC HD W:PSODELXF&('PSODLQT)&(PSOCPXC) ! D:PSOCPXC HD W:'PSODLQT&(PSOCPXC) " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S PSODELXF=1
  1. .K ^UTILITY($J,"W")
  1. D EN^PSODOSU2
  1. ENDZ ;
  1. I $G(PSORX("DFLG")) Q 0
  1. K PSODAILY
  1. I '$G(PSODLALZ),'$G(PSODLFLG),'$G(PSODLERR),'$G(PSODLOFF) Q 0
  1. D PROMPT Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 0
  1. I '$G(PSODLINS)&('$G(PSODLINR))&('$G(PSODLINX)) Q 0
  1. I '$G(PSOCPXF)&(PSOLASTS'=PSOCPXB),PSOEDOUT Q 0
  1. K PSODOSEX
  1. I $D(^XUSEC("PSORPH",DUZ)) D I Y'=1!($D(DTOUT))!($D(DUOUT))!($G(PSRX("DFLG"))) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
  1. .K DIR,Y S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR
  1. ENDZC ;
  1. I '$G(PSODLINS)&('$G(PSODLINR))&('$G(PSODLINX)) Q 0
  1. I '$D(^XUSEC("PSORPH",DUZ)),$G(PSODLINS)!($G(PSODLINR))!($G(PSODLINX)) Q 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
  1. G ENDZ2:$G(PSORX("EDIT"))!($G(PSORXED)&$G(PSOEDDOS))!($G(PSOCOPY)&$G(PSODLBD4))
  1. W !!,"Do you want to Process or Cancel medication?" K DIR,Y S DIR("B")="P",DIR(0)="SA^1:PROCESS MEDICATION;0:CANCEL MEDICATION"
  1. S DIR("A")=$$GETGN(PSODRUG("IEN"))_": " K ^TMP($J,"PSODOSUN GN")
  1. S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'C' to Cancel Medication"
  1. D ^DIR K DIR,PSODOSEX
  1. I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
  1. S PSOSIGC=0
  1. SIG2 ;
  1. D SIG^XUSESIG
  1. I 'PSOSIGC&($G(X1)="") D MSG1 S PSOSIGC=PSOSIGC+1 G SIG2
  1. I $G(X1)="" D MSG2 Q 1
  1. ENDZ2 ;
  1. I $G(PSORX("DFLG")) Q 0
  1. Q 2_"^"_$S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
  1. HD ;
  1. I PSODLQT!(($Y+5)'>IOSL) Q
  1. N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1. I $D(^XUSEC("PSORPH",DUZ)) D I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1,PSORX("DFLG")=1 Q 1
  1. .K DIR,Y S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR
  1. W @IOF W !
  1. Q
  1. MESG ;Write out System error heading
  1. I 'PSODLQT D HD W !,"Dosing Checks could not be performed.",!
  1. Q
  1. GETGN(PSODRIEN) ;get generic name
  1. K ^TMP($J,"PSODOSUN GN")
  1. D DATA^PSS50(PSODRIEN,,,,,"PSODOSUN GN")
  1. Q $S($D(^TMP($J,"PSODOSUN GN",PSODRIEN,.01)):^TMP($J,"PSODOSUN GN",PSODRIEN,.01),1:"")
  1. ;
  1. PROMPT ;
  1. ;assumes that a previous check was made to verify that errors, exceptions or messages are present
  1. ;if only warnings (exceptions/errors) then display "Press return to continue"; otherwise display "Do you want to continue" prompt.
  1. ;FINISH and BACKDOOR are separated below in order keep to a mininum the vast number of scenarios to be tested
  1. I $G(PSODLOFF)&(($Y+5)>IOSL) D RETURN Q
  1. I $G(PSOFOERR) D ;FINISH
  1. .Q:$D(^XUSEC("PSORPH",DUZ))&('$G(PSORENWD))
  1. .I '$G(PSODLFLG) D
  1. ..Q:'$G(PSOEDOUT)&$D(^XUSEC("PSORPH",DUZ))&('$G(PSORENWD)) ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
  1. ..I '$G(PSORENWD) Q:PSOCPXB<4&('$G(PSODOSX))
  1. ..D RETURN
  1. ;
  1. I '$G(PSOFOERR)&'$G(PSODLFLG) D ;BACKDOOR
  1. .Q:'$G(PSOEDOUT)&$D(^XUSEC("PSORPH",DUZ))&('$G(PSORENWD)) ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
  1. .I '$G(PSORENWD),('$D(^XUSEC("PSORPH",DUZ))&'$G(PSODCAN)) Q:PSOCPXB<4&('$G(PSODOSX))
  1. .D RETURN
  1. ;
  1. I $G(PSODLFLG)&'$D(^XUSEC("PSORPH",DUZ)) D
  1. .I '$G(PSORENWD),('$D(^XUSEC("PSORPH",DUZ))&'$G(PSODCAN)) Q:PSOCPXB<4&('$G(PSODOSX))
  1. .D RETURN
  1. Q
  1. ;
  1. RETURN ;
  1. Q:'$D(^XUSEC("PSORPH",DUZ))&($Y<10)
  1. W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:'Y PSODLQT=1,PSOQTOUT=1,PSORX("DFLG")=1 W @IOF
  1. Q
  1. ;
  1. HD3(PSOLINES,OVRRID) ;
  1. N X,Y,DTOUT,DUOUT,DIR
  1. S:'$G(PSODLQT) PSODLQT=0 S:'$G(OVRRID) OVRRID=0 S:'$G(PSOLINES) PSOLINES=5
  1. I '$G(OVRRID),$G(PSODLQT)!(($Y+PSOLINES)<IOSL) Q
  1. N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y W ! K DIR,Y S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR,PSOLINES,OVRRID
  1. I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
  1. W @IOF
  1. Q
  1. ;
  1. MSG1 ;
  1. W !!," *** You must enter your Current Signature Code. ***"
  1. Q
  1. MSG2 ;
  1. W !!," *** A Signature Code must be entered to continue with this order. ***",!
  1. MSG3 ;
  1. N MSGX,DIR
  1. W ! K DIR S DIR(0)="E",DIR("A")="Press <Enter> to return to the order..." D ^DIR
  1. S PSODLQT=1,PSOQTOUT=1,PSORX("DFLG")=1
  1. Q
  1. ;