PSJOCDSD ; BIR/MV,RN - PROCESS DOSING ORDER CHECKS ;6 Jun 07 3:37 PM
;;5.0;INPATIENT MEDICATIONS;**181,252,281,256,347,358**;16 DEC 97;Build 10
;
DISPLAY ;Display dose checks
NEW PSJPON,PSJDSPFG,PSJCNT0,DR,PSJONLST,PSJBRK
D FULL^VALM1
I $D(^TMP($J,"PSJPRE1","OUT")),'$D(PSJEXCPT("PROSPECTIVE")) W @IOF
Q:'$$DSPSERR^PSJOC("Dosing Checks could not be performed.")
D EXCEPTN2
F PSJCNT0=0:0 S PSJCNT0=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0)) Q:'PSJCNT0 Q:$G(PSGORQF) D
. S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON)) Q:PSJPON="" Q:$G(PSGORQF) D
.. Q:PSJPON=0
.. D ERROR
.. D EXCEPTN
.. D WARNING
I $D(^TMP($J,"PSJPRE1","OUT")),('$D(PSJEXCPT("PROSPECTIVE"))!$G(PSJBRK)),'$G(PSJDSPFG) D PAUSE^PSJLMUT1
;I $D(^TMP($J,"PSJPRE1","OUT")),'$G(PSJDSPFG) D PAUSE^PSJLMUT1
K PSJDSPFG,PSJEXCPT("PROSPECTIVE")
Q
DOSEOFF(PSJMSG) ;
;Display message if dosing had turned off (once per patient session)
Q:$D(PSJEXCPT("DOSE",0))
S PSJEXCPT("DOSE",0)=""
W !!,$G(PSJMSG),!
D PAUSE^PSJLMUT1
Q
WARNING ;Display warning messages
NEW PSJSGLE,PSJRNGE,PSJMSG,PSJDD,PSJTYPE,PSJORI
;I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
S PSJMSG="",PSJORI=""
S (PSJSGLE,PSJRNGE)=0
S PSJTYPE="" F S PSJTYPE=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE)) Q:PSJTYPE="" D
.IF PSJTYPE=".1_INTRO" SET PSJORI=^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE) D Q
..S PSJBRK=0
..I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
..W !
..D WRITE^PSJMISC(PSJORI,1)
.I PSJTYPE="4_TRAIL" S PSJMSG=^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE) D Q
..I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
..I ($Y+6)'>IOSL W !
..D WRITE^PSJMISC(PSJMSG,3)
..S PSJBRK=1
. I ($Y+4)>IOSL D PAUSE^PSJLMUT1 W @IOF
. ;Don't display a blank line after Per Orifice text
. I $G(PSJORI)="" W !
. K PSJORI
. F PSJDD=0:0 S PSJDD=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD)) Q:'PSJDD D
.. Q:$G(PSGORQF)
.. S PSJMSG=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
.. I PSJTYPE="3_GENERAL" D GENERAL
.. I PSJTYPE'="3_GENERAL" D
... S PSJMSG=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
... D WRITE^PSJMISC(PSJMSG,3)
.. I PSJTYPE["1_SINGLE_RANGE" S (PSJSGLE,PSJRNGE)=1_U_PSJDD Q
.. S:PSJTYPE["1_SINGLE" PSJSGLE=1_U_PSJDD
.. S:PSJTYPE["2_RANGE" PSJRNGE=1_U_PSJDD
Q:$G(PSGORQF)
D INTERV
Q
INTERV ;Process intervention for dosing check
NEW PSJDD
S PSJDD=$S(+PSJSGLE:$P(PSJSGLE,U,2),1:$P(PSJRNGE,U,2))
I 'PSJDD,'$D(PSJOCFG) Q
K PSJDSPFG
I +PSJSGLE!+PSJRNGE W ! S PSJDSPFG=1
I +PSJSGLE,+PSJRNGE D RINTERV^PSJGMRA("MAX SINGLE DOSE & Max Daily Dose") Q
I +PSJRNGE D RINTERV^PSJGMRA("Max Daily Dose") Q
I +PSJSGLE D RINTERV^PSJGMRA("MAX SINGLE DOSE") Q
Q
ERROR ; Process errors
NEW PSJCNT,PSJNV
;Check for system error one more time.
F PSJCNT=0:0 S PSJCNT=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT)) Q:'PSJCNT D
. I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
. I ($Y+6)'>IOSL W !!
. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"MSG"))
. I PSJNV]"" D WRITE^PSJMISC(PSJNV,3)
. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"TEXT"))
. I PSJNV]"" D WRITE^PSJMISC(PSJNV,5)
. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"TRAIL"))
. I PSJNV]"" W ! D WRITE^PSJMISC(PSJNV,3)
Q
EXCEPTN ; Process exceptions
NEW PSJCNT,PSJNV,PSJSPACE,PSJQFLG1,PSJDSDRG,PSJXDRG,PSJQUIT
;Check for system error one more time.
;PSJOCFG - flag when order is Renew, Copy or New OE
S PSJSPACE=0
I $O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",0)) D
.I ($Y+4)>IOSL D PAUSE^PSJLMUT1 W @IOF
F PSJCNT=0:0 S PSJCNT=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT)) Q:'PSJCNT D
. S PSJQFLG1=0,PSJDSDRG=""
. S PSJDSDRG=$P($G(^TMP($J,"PSJPRE","IN","DOSE",PSJPON)),U,3)
. S PSJQUIT=0,PSJXDRG="" F S PSJXDRG=$O(PSJEXCPT("PROSPECTIVE",PSJXDRG)) Q:PSJXDRG="" I +PSJXDRG=+PSJDSDRG S PSJQUIT=1 Q
. Q:PSJQUIT
. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT))
. I PSJNV]"" D
.. I $E(PSJNV,1,13)=" " S PSJSPACE=13,PSJNV=$P(PSJNV," ",2)
.. I (PSJNV'["Reason(s)"),+'$G(PSJSPACE) W !
.. I PSJNV[" Reason(s)" S PSJNV=$P(PSJNV," ",2),PSJSPACE=2
.. D WRITE^PSJMISC(PSJNV,PSJSPACE+3)
. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT,"TRAIL"))
. I PSJNV]"" W ! D WRITE^PSJMISC(PSJNV,PSJSPACE+3)
Q
EXCEPTN2 ; Process exceptions on prospective drug
NEW PSJPON,PSJN,PSJNV
S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE1","OUT","EXCEPTIONS",PSJPON)) Q:PSJPON="" D
. F PSJN=0:0 S PSJN=$O(^TMP($J,"PSJPRE1","OUT","EXCEPTIONS",PSJPON,PSJN)) Q:'PSJN D
.. S PSJNV=$G(^TMP($J,"PSJPRE1","OUT","EXCEPTIONS",PSJPON,PSJN))
.. I $P(PSJPON,";",3)="PROFILE" Q
.. I '$$ERRCHK^PSJOC("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10)) Q
.. Q:'$D(PSJOCFG)
.. W !
.. D DSPDRGER^PSJOC(1)
Q
GENERAL ;
NEW PSJGCNT
F PSJGCNT=0:0 S PSJGCNT=$O(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD,PSJGCNT)) Q:'PSJGCNT D
. S PSJMSG=$G(^TMP($J,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD,PSJGCNT))
.I ($Y+3)>IOSL D PAUSE^PSJLMUT1 W @IOF
. D WRITE^PSJMISC(PSJMSG,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOCDSD 5308 printed Apr 09, 2024@21:04:13 Page 2
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
+2 ;
DISPLAY ;Display dose checks
+1 NEW PSJPON,PSJDSPFG,PSJCNT0,DR,PSJONLST,PSJBRK
+2 DO FULL^VALM1
+3 IF $DATA(^TMP($JOB,"PSJPRE1","OUT"))
IF '$DATA(PSJEXCPT("PROSPECTIVE"))
WRITE @IOF
+4 if '$$DSPSERR^PSJOC("Dosing Checks could not be performed.")
QUIT
+5 DO EXCEPTN2
+6 FOR PSJCNT0=0:0
SET PSJCNT0=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0))
if 'PSJCNT0
QUIT
if $GET(PSGORQF)
QUIT
Begin DoDot:1
+7 SET PSJPON=""
FOR
SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON))
if PSJPON=""
QUIT
if $GET(PSGORQF)
QUIT
Begin DoDot:2
+8 if PSJPON=0
QUIT
+9 DO ERROR
+10 DO EXCEPTN
+11 DO WARNING
End DoDot:2
End DoDot:1
+12 IF $DATA(^TMP($JOB,"PSJPRE1","OUT"))
IF ('$DATA(PSJEXCPT("PROSPECTIVE"))!$GET(PSJBRK))
IF '$GET(PSJDSPFG)
DO PAUSE^PSJLMUT1
+13 ;I $D(^TMP($J,"PSJPRE1","OUT")),'$G(PSJDSPFG) D PAUSE^PSJLMUT1
+14 KILL PSJDSPFG,PSJEXCPT("PROSPECTIVE")
+15 QUIT
DOSEOFF(PSJMSG) ;
+1 ;Display message if dosing had turned off (once per patient session)
+2 if $DATA(PSJEXCPT("DOSE",0))
QUIT
+3 SET PSJEXCPT("DOSE",0)=""
+4 WRITE !!,$GET(PSJMSG),!
+5 DO PAUSE^PSJLMUT1
+6 QUIT
WARNING ;Display warning messages
+1 NEW PSJSGLE,PSJRNGE,PSJMSG,PSJDD,PSJTYPE,PSJORI
+2 ;I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
+3 SET PSJMSG=""
SET PSJORI=""
+4 SET (PSJSGLE,PSJRNGE)=0
+5 SET PSJTYPE=""
FOR
SET PSJTYPE=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE))
if PSJTYPE=""
QUIT
Begin DoDot:1
+6 IF PSJTYPE=".1_INTRO"
SET PSJORI=^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE)
Begin DoDot:2
+7 SET PSJBRK=0
+8 IF ($Y+6)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
+9 WRITE !
+10 DO WRITE^PSJMISC(PSJORI,1)
End DoDot:2
QUIT
+11 IF PSJTYPE="4_TRAIL"
SET PSJMSG=^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE)
Begin DoDot:2
+12 IF ($Y+6)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
+13 IF ($Y+6)'>IOSL
WRITE !
+14 DO WRITE^PSJMISC(PSJMSG,3)
+15 SET PSJBRK=1
End DoDot:2
QUIT
+16 IF ($Y+4)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
+17 ;Don't display a blank line after Per Orifice text
+18 IF $GET(PSJORI)=""
WRITE !
+19 KILL PSJORI
+20 FOR PSJDD=0:0
SET PSJDD=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
if 'PSJDD
QUIT
Begin DoDot:2
+21 if $GET(PSGORQF)
QUIT
+22 SET PSJMSG=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
+23 IF PSJTYPE="3_GENERAL"
DO GENERAL
+24 IF PSJTYPE'="3_GENERAL"
Begin DoDot:3
+25 SET PSJMSG=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD))
+26 DO WRITE^PSJMISC(PSJMSG,3)
End DoDot:3
+27 IF PSJTYPE["1_SINGLE_RANGE"
SET (PSJSGLE,PSJRNGE)=1_U_PSJDD
QUIT
+28 if PSJTYPE["1_SINGLE"
SET PSJSGLE=1_U_PSJDD
+29 if PSJTYPE["2_RANGE"
SET PSJRNGE=1_U_PSJDD
End DoDot:2
End DoDot:1
+30 if $GET(PSGORQF)
QUIT
+31 DO INTERV
+32 QUIT
INTERV ;Process intervention for dosing check
+1 NEW PSJDD
+2 SET PSJDD=$SELECT(+PSJSGLE:$PIECE(PSJSGLE,U,2),1:$PIECE(PSJRNGE,U,2))
+3 IF 'PSJDD
IF '$DATA(PSJOCFG)
QUIT
+4 KILL PSJDSPFG
+5 IF +PSJSGLE!+PSJRNGE
WRITE !
SET PSJDSPFG=1
+6 IF +PSJSGLE
IF +PSJRNGE
DO RINTERV^PSJGMRA("MAX SINGLE DOSE & Max Daily Dose")
QUIT
+7 IF +PSJRNGE
DO RINTERV^PSJGMRA("Max Daily Dose")
QUIT
+8 IF +PSJSGLE
DO RINTERV^PSJGMRA("MAX SINGLE DOSE")
QUIT
+9 QUIT
ERROR ; Process errors
+1 NEW PSJCNT,PSJNV
+2 ;Check for system error one more time.
+3 FOR PSJCNT=0:0
SET PSJCNT=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT))
if 'PSJCNT
QUIT
Begin DoDot:1
+4 IF ($Y+6)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
+5 IF ($Y+6)'>IOSL
WRITE !!
+6 SET PSJNV=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"MSG"))
+7 IF PSJNV]""
DO WRITE^PSJMISC(PSJNV,3)
+8 SET PSJNV=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"TEXT"))
+9 IF PSJNV]""
DO WRITE^PSJMISC(PSJNV,5)
+10 SET PSJNV=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"ERROR",PSJCNT,"TRAIL"))
+11 IF PSJNV]""
WRITE !
DO WRITE^PSJMISC(PSJNV,3)
End DoDot:1
+12 QUIT
EXCEPTN ; Process exceptions
+1 NEW PSJCNT,PSJNV,PSJSPACE,PSJQFLG1,PSJDSDRG,PSJXDRG,PSJQUIT
+2 ;Check for system error one more time.
+3 ;PSJOCFG - flag when order is Renew, Copy or New OE
+4 SET PSJSPACE=0
+5 IF $ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",0))
Begin DoDot:1
+6 IF ($Y+4)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
End DoDot:1
+7 FOR PSJCNT=0:0
SET PSJCNT=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT))
if 'PSJCNT
QUIT
Begin DoDot:1
+8 SET PSJQFLG1=0
SET PSJDSDRG=""
+9 SET PSJDSDRG=$PIECE($GET(^TMP($JOB,"PSJPRE","IN","DOSE",PSJPON)),U,3)
+10 SET PSJQUIT=0
SET PSJXDRG=""
FOR
SET PSJXDRG=$ORDER(PSJEXCPT("PROSPECTIVE",PSJXDRG))
if PSJXDRG=""
QUIT
IF +PSJXDRG=+PSJDSDRG
SET PSJQUIT=1
QUIT
+11 if PSJQUIT
QUIT
+12 SET PSJNV=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT))
+13 IF PSJNV]""
Begin DoDot:2
+14 IF $EXTRACT(PSJNV,1,13)=" "
SET PSJSPACE=13
SET PSJNV=$PIECE(PSJNV," ",2)
+15 IF (PSJNV'["Reason(s)")
IF +'$GET(PSJSPACE)
WRITE !
+16 IF PSJNV[" Reason(s)"
SET PSJNV=$PIECE(PSJNV," ",2)
SET PSJSPACE=2
+17 DO WRITE^PSJMISC(PSJNV,PSJSPACE+3)
End DoDot:2
+18 SET PSJNV=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"EXCEPTIONS",PSJCNT,"TRAIL"))
+19 IF PSJNV]""
WRITE !
DO WRITE^PSJMISC(PSJNV,PSJSPACE+3)
End DoDot:1
+20 QUIT
EXCEPTN2 ; Process exceptions on prospective drug
+1 NEW PSJPON,PSJN,PSJNV
+2 SET PSJPON=""
FOR
SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE1","OUT","EXCEPTIONS",PSJPON))
if PSJPON=""
QUIT
Begin DoDot:1
+3 FOR PSJN=0:0
SET PSJN=$ORDER(^TMP($JOB,"PSJPRE1","OUT","EXCEPTIONS",PSJPON,PSJN))
if 'PSJN
QUIT
Begin DoDot:2
+4 SET PSJNV=$GET(^TMP($JOB,"PSJPRE1","OUT","EXCEPTIONS",PSJPON,PSJN))
+5 IF $PIECE(PSJPON,";",3)="PROFILE"
QUIT
+6 IF '$$ERRCHK^PSJOC("PROSPECTIVE",$PIECE(PSJNV,U,3)_$PIECE(PSJNV,U,10))
QUIT
+7 if '$DATA(PSJOCFG)
QUIT
+8 WRITE !
+9 DO DSPDRGER^PSJOC(1)
End DoDot:2
End DoDot:1
+10 QUIT
GENERAL ;
+1 NEW PSJGCNT
+2 FOR PSJGCNT=0:0
SET PSJGCNT=$ORDER(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD,PSJGCNT))
if 'PSJGCNT
QUIT
Begin DoDot:1
+3 SET PSJMSG=$GET(^TMP($JOB,"PSJPRE1","OUT",PSJCNT0,PSJPON,"MESSAGE",PSJTYPE,PSJDD,PSJGCNT))
+4 IF ($Y+3)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
+5 DO WRITE^PSJMISC(PSJMSG,3)
End DoDot:1
+6 QUIT
