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

PSJOCDSD.m

Go to the documentation of this file. 
  1. PSJOCDSD ; BIR/MV,RN - PROCESS DOSING ORDER CHECKS ;6 Jun 07  3:37 PM
  1.  ;;5.0;INPATIENT MEDICATIONS;**181,252,281,256,347,358**;16 DEC 97;Build 10
  1.  ;
  1. DISPLAY ;Display dose checks
  1.  NEW PSJPON,PSJDSPFG,PSJCNT0,DR,PSJONLST,PSJBRK
  1.  D FULL^VALM1
  1.  I $D(^TMP($J,"PSJPRE1","OUT")),'$D(PSJEXCPT("PROSPECTIVE")) W @IOF
  1.  Q:'$$DSPSERR^PSJOC("Dosing Checks could not be performed.")
  1.  D EXCEPTN2
  1.  F PSJCNT0=0:0 S PSJCNT0=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0)) Q:'PSJCNT0  Q:$G(PSGORQF)  D
  1.  . S PSJPON="" F  S PSJPON=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON)) Q:PSJPON=""  Q:$G(PSGORQF)  D
  1.  .. Q:PSJPON=0
  1.  .. D ERROR
  1.  .. D EXCEPTN
  1.  .. D WARNING
  1.  I $D(^TMP($J,"PSJPRE1","OUT")),('$D(PSJEXCPT("PROSPECTIVE"))!$G(PSJBRK)),'$G(PSJDSPFG) D PAUSE^PSJLMUT1
  1.  ;I $D(^TMP($J,"PSJPRE1","OUT")),'$G(PSJDSPFG) D PAUSE^PSJLMUT1
  1.  K PSJDSPFG,PSJEXCPT("PROSPECTIVE")
  1.  Q
  1. DOSEOFF(PSJMSG) ;
  1.  ;Display message if dosing had turned off (once per patient session)
  1.  Q:$D(PSJEXCPT("DOSE",0))
  1.  S PSJEXCPT("DOSE",0)=""
  1.  W !!,$G(PSJMSG),!
  1.  D PAUSE^PSJLMUT1
  1.  Q
  1. WARNING ;Display warning messages
  1.  NEW PSJSGLE,PSJRNGE,PSJMSG,PSJDD,PSJTYPE,PSJORI
  1.  ;I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  S PSJMSG="",PSJORI=""
  1.  S (PSJSGLE,PSJRNGE)=0
  1.  S PSJTYPE="" F  S PSJTYPE=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE)) Q:PSJTYPE=""  D
  1.  .IF PSJTYPE=".1_INTRO" SET PSJORI=^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE) D  Q
  1.  ..S PSJBRK=0
  1.  ..I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  ..W !
  1.  ..D WRITE^PSJMISC(PSJORI,1)
  1.  .I PSJTYPE="4_TRAIL" S PSJMSG=^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE) D  Q
  1.  ..I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  ..I ($Y+6)'>IOSL W !
  1.  ..D WRITE^PSJMISC(PSJMSG,3)
  1.  ..S PSJBRK=1
  1.  . I ($Y+4)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  . ;Don't display a blank line after Per Orifice text
  1.  . I $G(PSJORI)=""  W !
  1.  . K PSJORI
  1.  . F PSJDD=0:0 S PSJDD=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD)) Q:'PSJDD  D
  1.  .. Q:$G(PSGORQF)
  1.  .. S PSJMSG=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
  1.  .. I PSJTYPE="3_GENERAL" D GENERAL
  1.  .. I PSJTYPE'="3_GENERAL" D
  1.  ... S PSJMSG=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
  1.  ... D WRITE^PSJMISC(PSJMSG,3)
  1.  .. I PSJTYPE["1_SINGLE_RANGE" S (PSJSGLE,PSJRNGE)=1_U_PSJDD Q
  1.  .. S:PSJTYPE["1_SINGLE" PSJSGLE=1_U_PSJDD
  1.  .. S:PSJTYPE["2_RANGE" PSJRNGE=1_U_PSJDD
  1.  Q:$G(PSGORQF)
  1.  D INTERV
  1.  Q
  1. INTERV ;Process intervention for dosing check
  1.  NEW PSJDD
  1.  S PSJDD=$S(+PSJSGLE:$P(PSJSGLE,U,2),1:$P(PSJRNGE,U,2))
  1.  I 'PSJDD,'$D(PSJOCFG) Q
  1.  K PSJDSPFG
  1.  I +PSJSGLE!+PSJRNGE W ! S PSJDSPFG=1
  1.  I +PSJSGLE,+PSJRNGE D RINTERV^PSJGMRA("MAX SINGLE DOSE & Max Daily Dose") Q
  1.  I +PSJRNGE D RINTERV^PSJGMRA("Max Daily Dose") Q
  1.  I +PSJSGLE D RINTERV^PSJGMRA("MAX SINGLE DOSE") Q
  1.  Q
  1. ERROR ; Process errors
  1.  NEW PSJCNT,PSJNV
  1.  ;Check for system error one more time.
  1.  F PSJCNT=0:0 S PSJCNT=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT)) Q:'PSJCNT  D
  1.  . I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  . I ($Y+6)'>IOSL W !!
  1.  . S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"MSG"))
  1.  . I PSJNV]"" D WRITE^PSJMISC(PSJNV,3)
  1.  . S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"TEXT"))
  1.  . I PSJNV]"" D WRITE^PSJMISC(PSJNV,5)
  1.  . S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"TRAIL"))
  1.  . I PSJNV]"" W ! D WRITE^PSJMISC(PSJNV,3)
  1.  Q
  1. EXCEPTN ; Process exceptions
  1.  NEW PSJCNT,PSJNV,PSJSPACE,PSJQFLG1,PSJDSDRG,PSJXDRG,PSJQUIT
  1.  ;Check for system error one more time.
  1.  ;PSJOCFG - flag when order is Renew, Copy or New OE
  1.  S PSJSPACE=0
  1.  I $O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",0)) D
  1.  .I ($Y+4)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  F PSJCNT=0:0 S PSJCNT=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT)) Q:'PSJCNT  D
  1.  . S PSJQFLG1=0,PSJDSDRG=""
  1.  . S PSJDSDRG=$P($G(^TMP($J,"PSJPRE","IN","DOSE",PSJPON)),U,3)
  1.  . S PSJQUIT=0,PSJXDRG="" F  S PSJXDRG=$O(PSJEXCPT("PROSPECTIVE",PSJXDRG)) Q:PSJXDRG=""  I +PSJXDRG=+PSJDSDRG S PSJQUIT=1 Q
  1.  . Q:PSJQUIT
  1.  . S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT))
  1.  . I PSJNV]"" D
  1.  .. I $E(PSJNV,1,13)="             " S PSJSPACE=13,PSJNV=$P(PSJNV,"             ",2)
  1.  .. I (PSJNV'["Reason(s)"),+'$G(PSJSPACE) W !
  1.  .. I PSJNV["  Reason(s)" S PSJNV=$P(PSJNV,"  ",2),PSJSPACE=2
  1.  .. D WRITE^PSJMISC(PSJNV,PSJSPACE+3)
  1.  . S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT,"TRAIL"))
  1.  . I PSJNV]"" W ! D WRITE^PSJMISC(PSJNV,PSJSPACE+3)
  1.  Q
  1. EXCEPTN2 ; Process exceptions on prospective drug
  1.  NEW PSJPON,PSJN,PSJNV
  1.  S PSJPON="" F  S PSJPON=$O(^TMP($J,"PSJPRE1","OUT","EXCEPTIONS",PSJPON)) Q:PSJPON=""  D
  1.  . F PSJN=0:0 S PSJN=$O(^TMP($J,"PSJPRE1","OUT","EXCEPTIONS",PSJPON,PSJN)) Q:'PSJN  D
  1.  .. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT","EXCEPTIONS",PSJPON,PSJN))
  1.  .. I $P(PSJPON,";",3)="PROFILE" Q
  1.  .. I '$$ERRCHK^PSJOC("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10)) Q
  1.  .. Q:'$D(PSJOCFG)
  1.  .. W !
  1.  .. D DSPDRGER^PSJOC(1)
  1.  Q
  1. GENERAL ;
  1.  NEW PSJGCNT
  1.  F PSJGCNT=0:0 S PSJGCNT=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD,PSJGCNT)) Q:'PSJGCNT  D
  1.  . S PSJMSG=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD,PSJGCNT))
  1.  .I ($Y+3)>IOSL D PAUSE^PSJLMUT1 W @IOF
  1.  . D WRITE^PSJMISC(PSJMSG,3)
  1.  Q