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

PSJOE.m

Go to the documentation of this file.
  1. PSJOE ;BIR/MLM - INPATIENT ORDER ENTRY ;Jan 14, 2021@10:49:31
  1. ;;5.0;INPATIENT MEDICATIONS;**7,26,29,33,42,50,56,72,58,85,95,80,110,111,133,140,151,149,181,252,281,315,256,344,327,319,411,364,399,407**;16 DEC 97;Build 26
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ; Reference to ^PS(55 via DBIA 2191
  1. ; Reference to EN^VALM via DBIA 10118
  1. ; Reference to FULL^VALM1 via DBIA 10116
  1. ; Reference to PAUSE^VALM1 via DBIA 10116
  1. ; Reference to ^PSSLOCK via DBIA 2789
  1. ; Reference to ^DPT( via DBIA 10035
  1. ; Reference to ^ORCFLAG via DBIA #3620
  1. ; Reference to ^SDAMA203 via DBIA #4133
  1. ; Reference to ^TMP("PSODAOC" via DBIA 6071
  1. ;
  1. ;*364 - add Hazardous Handle & Dispose flags alert message.
  1. ;*407 - Prevent access to PSJ OE when IV Room isn't built properly
  1. ;
  1. EN ; Start Inpatient LM OE
  1. N PSJLK,PSJNEWOE,PSJLMCON,PSJPROT,XQORS,VALMEVL D ENCV^PSGSETU,^PSIVXU
  1. ; I $D(XQUIT) K XQUIT G DONE ; PSJ*407
  1. I ($D(XQUIT)!$G(DONE)) K XQUIT G DONE ; PSJ*407
  1. K PSGVBY,PSJPR S (PSJOL,PSJACOK,PSGOP,PSGNEF,PSGOEAV,PSGPXN)="" L +^PS(53.45,PSJSYSP):1 E D LOCKERR^PSJOE G DONE^PSJOE
  1. F S (PSJLMCON,PSGPTMP)=0 D ^PSJP,HK Q:PSGP'>0 S PSJPROT=3,DFN=PSGP D ^PSJAC D I PSJLK D UL^PSSLOCK(PSGP)
  1. .K ^TMP("PSJ",$J)
  1. .S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q
  1. .K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO")
  1. .N NXTPT S NXTPT=0 F Q:$G(NXTPT) D
  1. ..K PSGRDTX
  1. ..I $G(PSJLMCON)!$G(PSJNEWOE) D
  1. ...S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
  1. ...S PSJLMPRO=1,PSJLMCON=1,PSJNEWOE=0 D EN^VALM("PSJ LM OE")
  1. ..I $G(PSJNEWOE)!($G(VALMBCK)="Q") S PSJNEWOE=0 Q
  1. ..I $G(PSJLMCON)&$G(PSJLMPRO)&'$D(^TMP("PSJ",$J)) D Q
  1. ...S PSJLMCON=0,PSJLMPRO=0 D EN^VALM("PSJ LM BRIEF PATIENT INFO")
  1. ...I $G(PSJNEWOE) S NXTPT=0 Q
  1. ...S NXTPT=1
  1. ..S NXTPT=1,PSJNEWOE=0
  1. .S PSJOL="S"
  1. .I $G(PSGPXN) I $P(PSJSYSW0,U,29)]""!($G(PSJCOM)) S PSGPXPT=PSGP D K PSGPXPT S PSGPXN=0
  1. ..N DFN,PSGP,PSJPXDP
  1. ..I $P(PSJSYSW0,U,29)="" S PSJPDXP=1 D
  1. ...;N IO,ION,IOS D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS)
  1. ...D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS)
  1. ..S (PSGP,DFN)=PSGPXPT D ^PSGPER S:$G(PSJPDXP) $P(PSJSYSW0,U,29)="" K PSJPDXP
  1. .D ENCV^PSGSETU,^PSIVXU
  1. K PSJLMPRO,^TMP("PSJPRO",$J),^TMP("PSJ",$J),^TMP("PSJON",$J)
  1. DONE ;
  1. ; -- RTC 198753 - correct typo - r PSJALGSV w PSJAGYSV
  1. K PSJAGYSV,PSJEXCPT,PSJOCER,^TMP($J,"PSJPRE"),^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J)
  1. K AC,ACTION,D1,D2,MI,N,ON,P3,PNOW,PSIVAT,PSIVLN,PSIVSTR L -^PS(53.45,PSJSYSP)
  1. K DA,DRG,NE,PSGCF,PSGCANFL,PSGNEDFD,PSGNEF,PSGNEFD,PSGNEPR,PSGNESD,PSJACOK,PSJOE,PSJOECNT,PSJOEPF,PSJORD,PSGOEA,PSGOEAV,PSGOL,PSGOS,PSGON,PSGOP,PSGORD,PSGS0XT,PSGS0Y,RCT,ST,WD,XREF,Z,PSJIVORF,PSJIVPCL
  1. K PSGOEORF,PSIVREA,PSJOPC,PSJORL,PSJORPCL,PSJORTOI,RF,WSCHADM,PSJLM,PSJCT
  1. K DIU,DRGI,FLAG,FQC,ND2,PRI,PSGOE,PSGPRI,PSGSDN,PSGOEDMR,PSGOEPR,PSGPTS,PSGTOL,PSGTOO,PSGUOW,PSJIVOF,PSJOCNT,PSJON,PSJORQF,PSJORTOU,PSJORVP
  1. K PSIVENO,PSGRMV,PSGRMVT,PSGDUR,PSGRF,ND2P1 ;*315
  1. G:$G(PSGPXN) ^PSGPER1 D ENIVKV^PSGSETU
  1. Q
  1. HK ; Housekeeping (a nice COBOL term)
  1. I PSGOP,PSGOP'=PSGP D
  1. .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
  1. .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,"^",2)]"" ENQL^PSGLW
  1. Q:PSGP<0
  1. S (DFN,PSGOP)=PSGP,X=""
  1. Q
  1. SELECT ; Select order from list
  1. ;Variable PSJOCDSC is used in Complex order dosing checks
  1. N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX,PSJOCDSC,PSJAGYSV K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J),PSJSTARI,^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J)
  1. K PSGDUR,PSGRMVT,PSGRMV,PSGRF,ND2P1 ;*315
  1. S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON
  1. I "^"[X S VALMQUIT=1 Q
  1. S PSJLM=1,PSJSEL=0 F S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL!($G(Y)<0) F PSJSEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D
  1. .K PSJOCDSC
  1. .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA Q:PSJORD=""!($G(Y)<0) Q:PSJORD=+PSJORD D
  1. ..Q:('$$LS^PSSLOCK(PSGP,PSJORD))
  1. ..Q:PSJORD=+PSJORD
  1. ..S PSGORD=""
  1. ..D DISACTIO(PSGP,PSJORD,"") S:PSJORD["V" PSJORD=ON
  1. ..D UNL^PSSLOCK(PSGP,PSJORD) Q:$G(Y)<0
  1. S VALMBCK="Q"
  1. K PSJLM,PSJOCDSC
  1. Q
  1. DISACTIO(DFN,PSJORD,PSJPNV) ; Display UD order and allow actions.
  1. ; PSJORD - Order #_location Code (P:53.1,V:55.01,U:55.06)
  1. ; PSJPNV - Invoked from Pending/NV option; (gets different hidden menu)
  1. ; PSJDSVFY - Flag if non-vf order was edited
  1. ; PSJENHOC=1 if DI,DT were display. This will be used by dosing OC to check if error messages should display or not
  1. ; PSJAGYSV=1 If UD was edited
  1. ;N PSGP,PSJIVFLG,PSGSDX,PSGFDX,PSJXX1,ON55,PSJDSVFY,PSJENHOC,PSJAGYSV
  1. N PSGP,PSJIVFLG,PSGSDX,PSGFDX,PSJXX1,ON55,PSJDSVFY,PSJENHOC,PSIVENO,PSJBACK
  1. K PSGDUR,PSGRMVT,PSGRMV,PSGRF,ND2P1 ;*315
  1. K PSJEXCPT("PROSPECTIVE") ;*256
  1. D OLDCOM^PSJOE0(DFN,PSJORD)
  1. S PSGP=DFN D ENIV^PSJAC I PSJORD["V" D EN^PSJLIORD(DFN,PSJORD) Q
  1. D GETUD^PSJLMGUD(DFN,PSJORD)
  1. S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
  1. S:$G(PSJTUD) PSGPD=$G(PSJCOI),PSGPDN=$$OINAME^PSJLMUTL(+PSGPD)
  1. K PSGOENG I '$D(PSGPRF) D Q:$G(PSGOENG)
  1. . I PSJORD["U" L +^PS(55,PSGP,5,+PSJORD):1 E S PSGOENG=1
  1. . I PSJORD["P" L +^PS(53.1,+PSJORD):1 E S PSGOENG=1
  1. . I $G(PSGOENG) W !,"This order is being edited by another terminal.",! S PSGOENG=1 K DIR S DIR(0)="E" D ^DIR K DIR Q
  1. S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD)
  1. I PSJORD["P" S PSJXX1=$G(^PS(53.1,+PSJORD,0)) I PSGP'=$P(PSJXX1,U,15)!(DFN'=$P(PSJXX1,U,15)) L -^PS(53.1,+PSJORD) Q
  1. I PSJORD["P" D S PSJXX1=$P($G(^PS(53.1,+PSJORD,0)),U,9) I $S($G(PSJIVFLG):1,$G(Y)<0:1,"PADE"[PSJXX1:1,1:0) L -^PS(53.1,+PSJORD) Q
  1. .K:$P($G(PSJXX1),U,4)="U" PSIVFLG ;p344
  1. .I $P(PSJXX1,U,9)="N",($P(PSJXX1,U,4)'="U") D Q
  1. .. S P("PON")=PSJORD,PSIVFLG=1
  1. .. N ON S ON=PSJORD D VF^PSIVORC2
  1. .I $P(PSJXX1,U,9)="P" D Q
  1. ..S:$G(PSJTUD) $P(PSJXX1,U,4)="U"
  1. ..I $P(PSJXX1,U,4)="U" D Q:$G(PSJIVFLG)
  1. ... N VAIP S CLINIC=$G(^PS(53.1,+PSJORD,"DSS")),APPT=$P(CLINIC,"^",2),CLINIC=$P(CLINIC,"^") I $$PATCH^XPDUTL("SD*5.3*285") S PSJBACK=$$SDIMO^SDAMA203(CLINIC,DFN) I PSJBACK'<-1 Q
  1. ... Q:'PSJPDD W !!,"Cannot process an Out-patient Unit Dose order for ",$P($G(^DPT(+PSGP,0)),U) D PAUSE^VALM1 S PSJIVFLG=1
  1. ..NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
  1. ..D REQDT^PSJLIVMD(PSJORD)
  1. ..I $P(PSJXX1,U,4)="U",($G(PSGSCH)="") W !!,"Invalid schedule, can't finish this order" D PAUSE^VALM1 Q
  1. ..I $P(PSJXX1,U,4)="U" N PSJLM,PSJOCFG S PSJLM=1,PSGORD=PSJORD,PSJOCFG="FN UD" D START^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD) S:$G(PSJTUD) PSJOCFG="FN UD" D @$S($G(PSJTUD):"FINISH^PSGOEF",1:"EN^VALM(""PSJ LM PENDING EDIT"")") K PSJOCFG Q
  1. ..I $P(PSJXX1,U,4)'="U",PSGP=$P(PSJXX1,U,15),DFN=$P(PSJXX1,U,15) S PSJLYN=PSJORD,PSJOCFG="FN IV" D EN^PSJLIFN S PSJIVFLG=1 K PSJLYN,PSJMAI,PSJOCFG
  1. I $G(PSIVFLG) K PSIVFLG Q
  1. S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD),PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSJORD),ENSFE^PSGOEE0(PSGP,PSJORD),EN^VALM("PSJ LM UD ACTION")
  1. I PSJORD["P" L -^PS(53.1,+PSJORD)
  1. I PSJORD["U" L -^PS(55,PSGP,5,+PSJORD)
  1. ;Send SN to CPRS if auto-verify OFF and Order Set Entry and no 21st piece
  1. S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
  1. I $D(PSGOES),'PSGOEAV,$D(PSGORD),PSGORD["P",$P($G(^PS(53.1,+PSGORD,0)),"^",21)']"" D ORSET^PSGOETO1
  1. I $G(PSGOEAV),($G(PSGOES)=1) D SETOC ;Store allergy for order set /w auto vf
  1. I '$G(PSGOEAV),($G(PSJORD)["P"),$S($G(PSJAGYSV):1,($G(PSJOCFG)="NEW UD"):1,1:0) D SETOC
  1. ; -- RTC 236646
  1. K ^TMP("PSODAOC",$J,"ALLERGY")
  1. D UNL^PSSLOCK(PSGP,PSJORD)
  1. Q
  1. SETOC ;
  1. ;RTC 178789
  1. S ^TMP("PSODAOC",$J,"IP IEN")=PSJORD
  1. D SETOC^PSJNEWOC(PSJORD)
  1. K ^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J),PSJAGYSV,PSJOCFG
  1. Q
  1. EDIT(PSGP,PSGORD,PROMPT) ;
  1. N PSJOP,ANQX,PSGEDT
  1. S (ANQX,PSJOP)=0,PSGEDT=1
  1. S PSJOP=+Y(1)
  1. S PSJOP=$S(PSJOP=9:0,PSJOP=11:0,1:1)
  1. ;/RBN Begin modification for NCC moved code to ACT^PSGOEE
  1. I "DE"[$$GTSTATUS(PSGP,PSGORD) W !,"This order may not be edited." D PAUSE^VALM1 Q
  1. I PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q
  1. N PSJEDITO S PSJEDITO=1
  1. S PSJAGYSV=1 ;Flag to store allergy data in 100.05.
  1. S PSGNEDFD="" D HOLDHDR,@$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") I 'Y D ABORT^PSGOEE Q
  1. I PSGORD["P" D ENF^PSGOEE Q
  1. D ACT^PSGOEE
  1. Q
  1. RENEW(PSGP,PSGORD) ;
  1. ;PSJOCFG - If defined, it's for new order, renew or copy. ^PSJOCDSD using this flag to not display drug error.
  1. ;/RJS Begin modifications for PSJ*5.0*327
  1. I $$ISCLOZ^PSJCLOZ(,,PSGP,+PSGORD) D Q
  1. .W !,"Clozapine orders cannot be renewed."
  1. .W !,"No order entered!"
  1. .D PAUSE^VALM1
  1. ;/RJS End modifications for PSJ*5.0*327
  1. NEW PSJOCFG
  1. S PSJOCFG="RENEW UD"
  1. D HOLDHDR
  1. I 'PSJSYSU,$P($G(^PS(55,PSGP,5,+PSGORD,4)),U,15),$P($G(^(4)),U,16) W !!,"This order is already marked for renewal!" D PAUSE^VALM1 S VALMBCK="R" Q
  1. I 'PSGRRF D ^PSGOER K PSJOCFG Q
  1. D ^PSGOERI
  1. K PSJOCFG
  1. Q
  1. GTSTATUS(DFN,ON) ;
  1. I ON["P" Q $P($G(^PS(53.1,+ON,0)),U,9)
  1. I ON["U" Q $P($G(^PS(55,DFN,5,+ON,0)),U,9)
  1. Q $P($G(^PS(55,DFN,"IV",+ON,0)),U,17)
  1. DC(DFN,PSJORD) ; DC IV, UD, or pending orders.
  1. D HOLDHDR
  1. S X=$$GTSTATUS(DFN,PSJORD) I X="D"!(X="DE")!(X="R") W !,$S(X="R":"This order has a pending renewal and cannot be DISCONTINUED.",1:"This order has already been DISCONTINUED.") D PAUSE^VALM1 Q
  1. D ENO^PSGOEC(DFN,PSJORD) ;,GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S VALMBCK="Q"
  1. S VALMBCK="Q"
  1. Q
  1. HOLD(DFN,PSJORD) ; Change order's status from ACTIVE<->HOLD
  1. D HOLDHDR
  1. I PSJORD["V" D H^PSIVOPT(DFN,PSJORD,P(17),P(3))
  1. I PSJORD'["V" D H^PSGOE1(DFN,PSJORD)
  1. D GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S PSGACT=$$ENACTION^PSGOE1(DFN,PSJORD),VALMBCK="R"
  1. Q
  1. COPY(PSGP,PSGORD) ; Copy an order (does not discontinue original order)
  1. N PSJOCFG
  1. ; PSJ*5*327 - disallow copy for clozapine
  1. I $D(^PS(55,PSGP,5,+PSGORD,"SAND")) W !!,"You cannot copy a clozapine order." D PAUSE^VALM1 Q
  1. I $D(PSGCOPY) W !!,"You cannot copy the order at this time" D PAUSE^VALM1 Q
  1. I PSGORD["P" W !!,"You cannot copy this "_$S($G(PSGSTAT)]"":PSGSTAT,1:"PENDING IV")_" order." D PAUSE^VALM1 Q
  1. I PSGORD["V" D Q
  1. .I $G(PSIVCOPY) W !!,"You cannot copy the order at this time" D PAUSE^VALM1 Q
  1. .S PSJOCFG="COPY IV"
  1. .D COPY^PSIVOD(PSGP,PSGORD) K PSJOCFG Q
  1. Q:'$$HIDDEN^PSJLMUTL("COPY")
  1. D ^PSJHVARS
  1. I $P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,4)="D",'$P($G(^(4)),"^",3) W !!,"Nurse verified orders with a priority of DONE may not be Copied." D PAUSE^VALM1 Q
  1. S PSJOCFG="COPY UD"
  1. S PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU
  1. S PSGCOPY=1,ANQX=0
  1. D FULL^VALM1,^PSGOD
  1. ;/RBN Begin modifications PSJ*5.0*327
  1. I $G(ANQX) K PSGCOPY Q
  1. ;/RBN End modifications PSJ*5.0*327
  1. S VALMBCK="R"
  1. K PSGCOPY,PSJOCFG
  1. S PSGACT=$$ENACTION^PSGOE1(PSGP,PSGORD) ; resets PSGACT after copy
  1. I $G(PSGPXN) N PSGTMPXN S PSGTMPXN=PSGPXN
  1. D RESTORE^PSJHVARS I $G(PSGTMPXN) S PSGPXN=PSGTMPXN
  1. Q
  1. UPDATE ; Refresh array, actions, & display.
  1. D GETUD^PSJLMGUD(DFN,ON),INIT^PSJLMUDE(DFN,ON) S VALMBCK="R"
  1. Q
  1. FINISH ;
  1. D FINISH^PSGOEF,PAUSE^VALM1
  1. Q
  1. LOG(DFN,PSGORD) ;
  1. D FULL^VALM1,ENLM^PSGOEL(DFN,PSGORD),PAUSE^VALM1 S VALMBCK="R"
  1. Q
  1. NEWSEL ;
  1. N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX,PSJOCDSC,PSJAGYSV K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J),^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J)
  1. K PSGRMVT,PSGRMV,PSGDUR,PSGRF,ND2P1,PSGOROE1
  1. K PSGDRG,PSGDRGN ;*364
  1. ;; START NCC REMEDIATION >> 327*RJS ; Freeze header text while processing order actions
  1. S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC
  1. ;; END NCC REMEDIATION << 327*RJS
  1. S X=$P(XQORNOD(0),"=",2)
  1. S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0)
  1. D ENCHK^PSGON I '$O(PSGODDD(0)) S VALMQUIT=1 Q
  1. S PSJLM=1,PSJSEL=0 F S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL F PSJSEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D
  1. .K PSJOCDSC,PSGDRG N PSGIND,PSGOIND ;*399-IND
  1. .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA
  1. .Q:PSJORD=+PSJORD
  1. .Q:PSJORD=""!($G(Y)<0) Q:('$$LS^PSSLOCK(PSGP,PSJORD)) D
  1. ..S PSGORD=""
  1. ..S ON=PSJORD
  1. ..D DISACTIO(PSGP,PSJORD,$G(PSJPNV)) S:PSJORD["V" PSJORD=ON
  1. ..D UNL^PSSLOCK(PSGP,PSJORD)
  1. ..I $G(PSJNOL) K PSJNOL I $D(ON),ON'=PSJORD D UNL^PSSLOCK(PSGP,ON)
  1. ..Q:$G(Y)<0
  1. I '$G(PSGOEAV),($G(PSJORD)["P"),$G(PSJAGYSV) D
  1. .;RTC 178789
  1. .S ^TMP("PSODAOC",$J,"IP IEN")=PSJORD
  1. .D SETOC^PSJNEWOC(PSJORD)
  1. .K ^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J),PSJAGYSV
  1. S VALMBCK="Q"
  1. K PSJLM,PSJOCDSC
  1. ;*P319
  1. K PSJCLAPP,P("APPT"),P("CLIN"),PSJCMO,PSJCM01,P("PON")
  1. Q
  1. HOLDHDR ; Freeze header text while processing order actions
  1. I $D(VALM("TM")) S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC
  1. Q
  1. LOCKERR ;
  1. W !!,$C(7),"You are entering or editing an Inpatient Medication order in another session.",!,"Only one order entry/edit session is allowed for a user at a time.",!! N DIR S DIR(0)="E" D ^DIR
  1. Q
  1. FLAG(DFN,PSJORD) ;Flag order through CPRS entry point.
  1. N ORIFN,NODE0
  1. S NODE0=$S(PSJORD["V":$G(^PS(55,DFN,"IV",+PSJORD,0)),PSJORD["U":$G(^PS(55,DFN,5,+PSJORD,0)),1:^PS(53.1,+PSJORD,0))
  1. S ORIFN=$P(NODE0,"^",21)
  1. D EN1^ORCFLAG(ORIFN)
  1. D PAUSE^VALM1
  1. Q
  1. COMPLEX(DFN,ON) ;
  1. N NDP2,COM
  1. S NDP2=$S(ON["P":$G(^PS(53.1,+ON,.2)),ON["U":$G(^PS(55,DFN,5,+ON,.2)),ON["V":$G(^PS(55,DFN,"IV",+ON,.2)),1:"")
  1. S COM=$P(NDP2,"^",8) I COM Q 1
  1. Q 0
  1. CLOZSND ; SEND CLOZAPINE OVERRIDE MESSAGE AND ORDER TO HINES DB
  1. ; START NCC REMEDIATION >> 327*RJS
  1. D PSJFILE^PSJCLOZ(DFN),INPSND^YSCLTST5
  1. ; END NCC REMEDIATION << 327*RJS
  1. Q