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

PSJOC.m

Go to the documentation of this file.
  1. PSJOC ;BIR/MV - NEW ORDER CHECKS DRIVER ; 9/10/14 10:53pm
  1. ;;5.0;INPATIENT MEDICATIONS;**181,260,252,257,281,256,364,426**;16 DEC 97;Build 4
  1. ;
  1. ; Reference to ^PSODDPR4 is supported by DBIA# 5366.
  1. ; Reference to ^PSSHRQ2 is supported by DBIA# 5369.
  1. ;
  1. ;*364 - add Hazardous Handle & Dispose flags alert message.
  1. ;
  1. OC(PSPDRG,PSJPTYP) ;
  1. ;PSPDRG - Drug array in format of PDRG(n)=IEN (#50) ^ Drug Name
  1. ;Where n is a sequential number. The Drug Name can be OI, Generic name from #50, or Add/Sol name
  1. ;PSJPTYP - P1 ; P2
  1. ; Where P1 is "I" for Inpatient, "O" for Outpatient
  1. ; P2 is the Inpatient Order Number (for PSJ use only)
  1. ;PSJOCERR(DRUG NAME)="Reason text". Where Drug Name can be either OI name or AD/SOL name.
  1. NEW PSJOCERR
  1. ;Quit OC if FDB link is down. PSGORQF is defined if user wish to stop the order process
  1. I $$SYS^PSJOCERR() Q
  1. ;
  1. I $D(PSJDGCK) W !!,"Building MEDS profile please wait...",!
  1. D BLD^PSODDPR4(DFN,"PSJPRE",.PSPDRG,PSJPTYP)
  1. D DISPLAY
  1. K ^TMP($J,"PSJPRE")
  1. Q
  1. DISPLAY ;
  1. NEW PSJPAUSE,PSJOLDSV,PSJDNM,PSJMON,PSJOC,PSJOCDT,PSJOCDTL,PSJOCLST,PSJP,PSJS,PSJPON,PSJDN,PSJSEV,PSJECNT
  1. N CROCLN,CROCLN2,PSJTOFFL,PSJCROCF,PSJDRGIF,PSJDERF2,PSJDUPTF
  1. D FULL^VALM1 W @IOF
  1. D GMRAOC Q:$G(PSGORQF)
  1. S $P(CROCLN,"=",75)="=",$P(CROCLN2,"-",75)="-",CROCNR=1
  1. I '$D(PSJDGCKX) D
  1. .I '$D(TMPDRG1("AD",0))&('$D(TMPDRG1("SOL",0)))&($G(PSPDRG(1))) D CK^PSJCROC($P(PSPDRG(1),"^")) I $G(PSGORQF) Q
  1. .I $G(TMPDRG1("AD",0))>0!$G(TMPDRG1("SOL",0))>0 W "Now processing Clinical Reminder Order Checks. Please wait ..."
  1. .I $G(TMPDRG1("AD",0))>0 F CRIV=0:0 S CRIV=$O(TMPDRG1("AD",CRIV)) Q:'CRIV D CKIV^PSJCROC($P(TMPDRG1("AD",CRIV),"^",1),"A")
  1. .I $G(TMPDRG1("SOL",0))>0 F CRIV=0:0 S CRIV=$O(TMPDRG1("SOL",CRIV)) Q:'CRIV D CKIV^PSJCROC($P(TMPDRG1("SOL",CRIV),"^",1),"S")
  1. .I $G(TMPDRG1("AD",0))>0!$G(TMPDRG1("SOL",0))>0 D CKIVD^PSJCROC I $G(PSGORQF) S VALMBCK="R" Q
  1. K CRIV,CROCPFLG,CROCNR,PSJDGCKX
  1. I $G(PSGORQF) Q
  1. Q:'$$DSPSERR()
  1. W !!,"Now Processing Enhanced Order Checks! Please wait...",! S PSJTOFFL=1
  1. ; If there are no OC or errors to display, this var will trigger a pause before continue /w the order
  1. S PSJPAUSE=1
  1. D DRUGERR
  1. I $D(PSJDGCK) W:'$D(^TMP($J,"PSJPRE","OUT","DRUGDRUG"))&'$D(^TMP($J,"PSJPRE","OUT","THERAPY",1)) !,"No Order Check Warnings Found",!
  1. ;Process drug interaction & drug interception
  1. D DI^PSJOCDI
  1. Q:$G(PSGORQF)
  1. D DSPERR^PSJOCERR("DRUGDRUG")
  1. ;Process duplicate therapy order checks
  1. D:'$D(PSJDGCK) DT^PSJOCDT
  1. I $D(PSJDGCK) D:$D(^TMP($J,"PSJPRE","OUT","THERAPY")) DTDGCK^PSJOCDT
  1. D:'$G(PSGORQF) DSPERR^PSJOCERR("THERAPY")
  1. I '$G(PSJTOFFL) W !!,"Now Processing Enhanced Order Checks! Please wait...",! I $G(PSIVCOPY)&('$D(PSJDGCK)) D PAUSE^PSJLMUT1
  1. I $D(PSJDGCK),'$D(^TMP($J,"PSJPRE","OUT","THERAPY")) D PAUSE^PSJLMUT1 Q ;DX action
  1. Q:$G(PSGORQF)
  1. I '$G(PSJDERF2)&('$G(PSJDRGIF))&('$G(PSJDUPTF)) K PSJPAUSE H 2
  1. I $G(PSJDERF2)&('$G(PSJDRGIF))&('$G(PSJDUPTF))&(($Y+3)<IOSL) S PSJPAUSE=1 ;error but no drug interaction or dup therapy
  1. I '$D(PSJDGCK) D:$G(PSJPAUSE) PAUSE^PSJLMUT1
  1. Q
  1. ;
  1. GMRAOC ;Display allergy & CPRS OC regardless if FDB is connected
  1. D HAZCHK ;Add Hazardous to Handle/Dispose warning messages *364
  1. D ALLERGY Q:$G(PSGORQF)
  1. D CPRS^PSJOCOR(.PSPDRG)
  1. Q
  1. ALLERGY ;Do allergy order check
  1. ;The allergy check will be processed for each of the dispense drug stores in the PSJALLGY array
  1. ;PSJALLGY(X)="" Where X is the disp drug IEN. PSJALLGY array store all dispense drugs use in an order
  1. ;
  1. D FULL^VALM1
  1. I $G(PSIALLFL) K PSIALLFL Q
  1. W !!,"Now doing allergy checks. Please wait..."
  1. N PSJAOC,DACNT,PSJDGFLG,PSJDGDRG S PSJAOC=1
  1. I '$D(PSJDGCK) D ;sort by generic dispensed drug name
  1. .NEW PSJDD,PSJGDDN,PSJALGCT,PSJALLGS S PSJDD=""
  1. .F S PSJDD=$O(PSJALLGY(PSJDD)) Q:'PSJDD!(PSJDD'?1N.N) S PSJGDDN="",PSJGDDN=$$GET1^DIQ(50,PSJDD,.01) D
  1. ..I PSJGDDN="" S PSJALLGY("AA",PSJDD_"Z",PSJDD)="" Q
  1. ..S PSJALLGY("AA",PSJGDDN,PSJDD)=""
  1. .S (PSJDD,PSJGGDN)=""
  1. .F S PSJGGDN=$O(PSJALLGY("AA",PSJGGDN)) Q:PSJGGDN=""!($G(PSGORQF)) F S PSJDD=$O(PSJALLGY("AA",PSJGGDN,PSJDD)) Q:PSJDD=""!($G(PSGORQF)) D
  1. ..S PSJALGCT=$G(PSJALGCT)+1 D EN^PSJGMRA(DFN,PSJDD)
  1. K PSJALLGY("AA")
  1. I $D(PSJDGCK) D ;CK ACTION
  1. .S PSJXX="" F S PSJXX=$O(PSJALLGY(PSJXX)) Q:PSJXX=""!(PSJXX'?1N.N) D
  1. ..S PSJGDDN="",PSJGDDN=$$GET1^DIQ(50,PSJXX,.01)
  1. ..I PSJGDDN="" S PSJALLGY($S(PSJALLGY(PSJXX)="P":"A",1:"Z"),PSJDD_"Z",PSJGDDN,PSJXX)="" Q
  1. ..S PSJALLGY($S(PSJALLGY(PSJXX)="P":"A",1:"Z"),PSJGDDN,PSJXX)=""
  1. .S (PSJALLGS,PSJXX,PSJGDDN)="",(PSJDGFLG,PSJYY)=1
  1. .F S PSJXX=$O(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJXX)) Q:PSJXX="" D
  1. ..S PSJCKDRG=$P(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJXX),U,3)
  1. ..S PSJGDDN=$$GET1^DIQ(50,PSJCKDRG,.01)
  1. ..S PSJALLGY($S($G(PSJALLGY(PSJCKDRG))="P":"A",1:"Z"),PSJGDDN_"Z",PSJCKDRG)=""
  1. ..I $G(PSJALLGY(PSJCKDRG))="P",$D(PSJALLGY("A",PSJGDDN,PSJCKDRG)) K PSJALLGY("A",PSJGDDN,PSJCKDRG)
  1. ..I $D(PSJALLGY(PSJCKDRG)) K PSJALLGY(PSJCKDRG)
  1. .S (PSJCC,PSJDD)=""
  1. .;CK action - If the manually entered drug is same as a profile drug, display as a profile drug.
  1. .F S PSJDD=$O(PSJALLGY("A",PSJDD)) Q:PSJDD="" F S PSJCC=$O(PSJALLGY("A",PSJDD,PSJCC)) Q:PSJCC="" D
  1. ..I $D(PSJALLGY("Z",PSJDD,PSJCC)) K PSJALLGY("A",PSJDD,PSJCC)
  1. .S (PSJALLGS,PSJDD,PSJCC)=""
  1. .F S PSJALLGS=$O(PSJALLGY(PSJALLGS)) Q:PSJALLGS="" F S PSJCC=$O(PSJALLGY(PSJALLGS,PSJCC)) Q:PSJCC=""!($G(PSGORQF)) D
  1. ..F S PSJDD=$O(PSJALLGY(PSJALLGS,PSJCC,PSJDD)) Q:PSJDD=""!($G(PSGORQF)) S:PSJALLGS="A" PSJDGFLG=0 D EN^PSJGMRA(DFN,PSJDD) S PSJDGFLG=1
  1. K PSJXX,PSJYY,PSJDD,PSJCC,PSJALLGY,DACNT,PSJGGDN
  1. Q
  1. DSPORD(ON,PSJNLST,PSJCLINF) ;Display the order data
  1. ;ON - ON_U/V/P ex: 21V
  1. ;PSJNLST - It's number list and also use to trigger pg break, line break
  1. NEW PSJCOL,PSJX,PSJOC,PSJLINE,X
  1. Q:ON=""
  1. S:'$D(PSJCLINF) PSJCLINF=";0"
  1. S PSJLINE=1,PSJCOL=1
  1. I $P(PSJCLINF,";",2) D CLNDISP^PSJCLNOC(.PSJCLINF) D Q
  1. .I $G(PSJNLST)="",(($Y+6)>IOSL) D PAUSE^PSJLMUT1 W @IOF
  1. I ON'["V" D DSPLORDU^PSJLMUT1(DFN,ON)
  1. I ON["V" D DSPLORDV^PSJLMUT1(DFN,ON)
  1. F PSJX=0:0 S PSJX=$O(PSJOC(ON,PSJX)) Q:'PSJX D
  1. . I $G(PSJNLST)="",(($Y+6)>IOSL) D PAUSE^PSJLMUT1 W @IOF
  1. . W !
  1. . I $G(PSJNLST) W:(PSJX=1) PSJNLST W:(PSJX>1) ?$L(PSJNLST)
  1. . S X=PSJOC(ON,PSJX)
  1. . W $E(X,9,$L(X))
  1. W !
  1. Q
  1. ;
  1. DRUGERR ;Display drug level errors
  1. NEW PSJPON,PSJN,PSJNV,PSJDSPFG,PSJPERR,PSJX,PSJLINEF
  1. ;Only display the exceptions once per patient. Use the exception from prospective drug if exception(s) existed for the
  1. ; same drug on the profile.
  1. ;PSJEXCPT(PSJDNM_REASON) - Array for invalid drugs that already display to once within a pt selection
  1. S PSJDSPFG=0
  1. S PSJPERR=$$PROSPERR()
  1. I PSJPERR D Q
  1. . I PSJDSPFG D PAUSE^PSJLMUT1
  1. I $D(PSJEXCPT("PROFILE")),'$G(PSJDGCK) Q
  1. S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON)) Q:PSJPON="" D
  1. . F PSJN=0:0 S PSJN=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN)) Q:'PSJN D
  1. .. I '$G(PSJLINEF) W ! S PSJLINEF=1
  1. .. S PSJNV=$G(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
  1. .. ;I ($P(PSJPON,";",3)="PROSPECTIVE") S PSJX='$$ERRCHK("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10))
  1. .. I ($P(PSJPON,";",3)'="PROFILE") Q
  1. .. I '$$ERRCHK("PROFILE",$P(PSJNV,U,3)_$P(PSJNV,U,10)) Q
  1. .. D DSPDRGER()
  1. I PSJDSPFG D PAUSE^PSJLMUT1 S PSJDERR2=1
  1. Q
  1. DSPDRGER(PSJDSFLG) ;
  1. NEW PSJTXT
  1. S PSJTXT=$P(PSJNV,U,7)
  1. ;W:$G(PSGCOPY)!($G(PSIVCOPY)) !
  1. S X="Enhanced Order Checks cannot "
  1. I $G(PSJDSFLG),(PSJTXT[X) S PSJTXT="Dosing Checks could not "_$P(PSJTXT,X,2)
  1. S PSJDSPFG=1
  1. K PSJPAUSE
  1. I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1. W !
  1. D WRITE^PSJMISC(PSJTXT,,79)
  1. I $P(PSJNV,U,10)]"" D WRITE^PSJMISC("Reason(s): "_$P(PSJNV,U,10),3,79) S PSJDERF2=1
  1. ;W !
  1. Q
  1. ERRCHK(PSJTYPE,PSJX) ;
  1. ;PSJTYPE - Either "PROFILE" or "PROSPECTIVE"
  1. ;PSJX - Drug name_Error reason
  1. ;Return 1 if this error drug has not displayed to the user.
  1. I $G(PSJX)="" Q 0
  1. I $G(PSJTYPE)="" Q 0
  1. ;I PSJTYPE="PROFILE",'$D(PSJEXCPT(PSJTYPE,PSJX)) S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
  1. I PSJTYPE="PROFILE" S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
  1. I PSJTYPE="PROSPECTIVE",'$D(PSJEXCPT(PSJTYPE,PSJX)) S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
  1. Q 0
  1. PING(PSJMSG) ;Check if FDB is down. Return 0 if it is
  1. ;pass in a message to customize the display
  1. S ^TMP($J,"PSJPRE","IN","PING")=""
  1. D IN^PSSHRQ2("PSJPRE")
  1. Q $$DSPSERR($G(PSJMSG))
  1. DSPSERR(PSJMSG) ;Display system errors
  1. NEW X
  1. S X=$G(^TMP($J,"PSJPRE","OUT",0))
  1. I $P(X,U)=-1 D NOFDB($P(X,U,2),$G(PSJMSG))
  1. Q $S($P(X,U)=-1:0,1:1)
  1. NOFDB(PSJX,PSJMSG) ;Display connection down message
  1. NEW X
  1. Q:$G(PSJX)=""
  1. I $G(PSJMSG)]"" W !!,PSJMSG
  1. I $G(PSJMSG)="" W !!,"No Enhanced Order Checks can be performed."
  1. W !," Reason(s): ",PSJX,!!
  1. K PSJX
  1. D:$G(PSJMSG)]"" PAUSE^PSJLMUT1
  1. Q
  1. PROSPERR() ;Display exceptions for prospective drug
  1. NEW PSJPON,PSJN,PSJNV,PSJPERR
  1. ;If all prospectives are caught in the exception then display them only and omit the profile drugs
  1. S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON)) Q:PSJPON="" D
  1. . F PSJN=0:0 S PSJN=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN)) Q:'PSJN D
  1. .. S PSJNV=$G(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
  1. .. I $P(PSJPON,";",3)="PROFILE" Q
  1. .. I ($P(PSJPON,";",3)="PROSPECTIVE") S PSJX='$$ERRCHK("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10))
  1. .. D DSPDRGER() S PSJDSPFG=1
  1. ;If the prospective drug(s) is caught in the exception, the exception for profile drug(s) is not display.
  1. ; The exception for the prospective is the only one need to display.
  1. S PSJPERR=1
  1. S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJPON)) Q:PSJPON="" D
  1. . I $D(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON)) Q
  1. . S (PSJDSPFG,PSJPERR)=0
  1. Q PSJPERR
  1. ;
  1. HAZCHK ;Check for a hazardous drug component and display soft error type warning roll and scroll alert *364
  1. N PSORDN,HDG,HAZ,HAZH,HAZD,HZAR,HTXT,LL,DRGIEN,TOP
  1. S (HAZH,HAZD)=0
  1. I $G(ON),'$G(PSGDRG),(($G(NAME)["PSJ LM UD")!($G(NAME)["PSJU LM")!($G(NAME)["PSJ LM PENDING")) D ;Unit Dose
  1. . I $G(PSGORD)["P" S PSORDN="^PS(53.1,"_+PSGORD_","
  1. . I '$G(PSGORD),ON["P" S PSORDN="^PS(53.1,"_+ON_","
  1. . I $G(PSGORD),ON["U" S PSORDN="^PS(55,"_DFN_",5,"_+ON_","
  1. . Q:'$D(PSORDN)
  1. . D HAZDRUG(PSORDN,.HZAR)
  1. I '$D(PSJALLGY),$G(PSGDRG),$G(NAME)'["PSJ LM IV" D ;IV new dispense only
  1. . S HZAR(PSGDRG)=$$HAZ^PSSUTIL(PSGDRG)
  1. I '$D(PSJALLGY),$G(PSJORD),$G(NAME)["PSJ LM IV" D ;IV pending or edit
  1. . S:PSJORD["P" PSORDN="^PS(53.1,"_+PSJORD_","
  1. . S:PSJORD["V" PSORDN="^PS(55,"_DFN_",""IV"","_+PSJORD_","
  1. . Q:'$D(PSORDN)
  1. . D HAZDRUG(PSORDN,.HZAR)
  1. I $D(PSJALLGY) F DRGIEN=0:0 S DRGIEN=$O(PSJALLGY(DRGIEN)) Q:'DRGIEN D ;IV new order add mix
  1. . S HZAR(DRGIEN)=$$HAZ^PSSUTIL(DRGIEN)
  1. ;display warning text(s)
  1. S HAZ=0,HDG=1,$P(LL,"-",80)="-"
  1. F DRGIEN=0:0 S DRGIEN=$O(HZAR(DRGIEN)) Q:'DRGIEN D
  1. . S HAZH=$P(HZAR(DRGIEN),U),HAZD=$P(HZAR(DRGIEN),U,2)
  1. . Q:'(HAZH!HAZD)!('$D(DRGIEN))
  1. . D HAZWARNG^PSSUTIL(DRGIEN,"I",HAZH,HAZD,.HTXT) S HAZ=1
  1. . I HDG W #,$C(7),LL,!,$J("***** WARNING *****",47) S HDG=0 ;header
  1. . D WRAPTEXT(HTXT,65,5) W ! ;body
  1. D:HAZ ;footer
  1. . W LL,!
  1. . K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR
  1. Q
  1. ;
  1. HAZDRUG(FILE,AR) ;Get Hazardous to Handle and Hazardous to Dispose fields per component and return Haz array by DRUG IEN *364
  1. ; FILE = file root + Order Num from inpatient variables during workflow; Example VAR contains: "^PS(55,DFN,5,ON," or "(PS(53.1,ON," or "^PS(55,DFN,"IV",ON,"
  1. ; (build ROOT to the multiple level to find all Disp Drugs or Additives or Solution and get HAZ flags)
  1. ; AR = array of component's IEN and their Haz flag settings
  1. N QQ,ROOT,NXTROOT,NXT,IFN,GL
  1. ;check IF Unit Dose Disp Drug exists for this order, then get IEN(s) and Haz flags
  1. I FILE[",5," F QQ=0:0 S ROOT=FILE_"1,"_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
  1. . S NXTROOT=FILE_"1,"_QQ_")" S NXT=$O(@NXTROOT) S GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
  1. . S AR(IFN)=$$HAZ^PSSUTIL(IFN)
  1. . ;check IF IV additives exist for this order, then get IEN(s) and Haz flags
  1. I FILE[",""IV""," F QQ=0:0 S ROOT=FILE_"""AD"","_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
  1. . S NXTROOT=FILE_"""AD"","_QQ_")" S NXT=$O(@NXTROOT) S GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
  1. . I IFN S IFN=+$P($G(^PS(52.6,IFN,0)),U,2),AR(IFN)=$$HAZ^PSSUTIL(IFN)
  1. . ;check IF IV solutions exist for this order, then get IEN(s) and Haz flags
  1. I FILE[",""IV""," F QQ=0:0 S ROOT=FILE_"""SOL"","_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
  1. . S NXTROOT=FILE_"""SOL"","_QQ_")" S NXT=$O(@NXTROOT) S GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
  1. . I IFN S IFN=+$P($G(^PS(52.7,IFN,0)),U,2),AR(IFN)=$$HAZ^PSSUTIL(IFN)
  1. Q
  1. ;
  1. WRAPTEXT(TEXT,LIMIT,CSPACES) ;Wrap text util copied in from a PSO routine originally *364
  1. ;;FUNCTION TO DISPLAY (WRITE) TEXT WRAPPED TO A CERTAIN COLUMN LENGTH
  1. ;;DEFAULT=74 CHARACTERS WITH NO SPACES IN FRONT
  1. N WORDS,COUNT,LINE,NEXTWORD
  1. Q:$G(TEXT)']"" ""
  1. S LIMIT=$G(LIMIT,74)
  1. S CSPACES=$S($G(CSPACES):CSPACES,1:0)
  1. S WORDS=$L(TEXT," ")
  1. W !,$$REPEAT^XLFSTR(" ",CSPACES)
  1. F COUNT=1:1:WORDS D
  1. . S NEXTWORD=$P(TEXT," ",COUNT)
  1. . Q:NEXTWORD="" ;TO REMOVE LEADING OR DOUBLE SPACES
  1. . S LINE=$G(LINE)_NEXTWORD_" "
  1. . I $L($G(LINE))>LIMIT W !,$$REPEAT^XLFSTR(" ",CSPACES) K LINE
  1. . W NEXTWORD_" "
  1. Q