ROUTINE PSJOE *7,26,29,33,42,50,56,72,58,85,95,80,110,111,133,140,151,149,181,LOCAL,CRH*
From VistApedia
Revision as of 19:43, 18 May 2015 by DavidWhitten (talk | contribs) (Created page with " __TOC__ == ROUTINE PSJOE == <pre>PSJOE * * 207 LINES, 10479 BYTES, RSUM: 26486001/88572395 Page 1 UCI: EHR,EHR Site: Central Regional Hospital MAY 18,2015@1...")
Contents
- 1 ROUTINE PSJOE
- 2 PSJOE^PSJOE
- 3 EN^PSJOE
- 4 DONE^PSJOE
- 5 HK^PSJOE
- 6 SELECT^PSJOE
- 7 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE
- 7.1 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE INTEGRATION AGREEMENTS
- 7.2 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE REFERENCED BY
- 7.3 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE REFERS TO
- 7.4 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE CALLED BY
- 7.5 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE CALLS
- 7.6 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE LOCKS
- 7.7 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE LOCALS
- 7.8 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE GLOBALS
- 7.9 DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE CODE
- 8 EDIT(PSGP,PSGORD,PROMPT)^PSJOE
- 8.1 EDIT(PSGP,PSGORD,PROMPT)^PSJOE INTEGRATION AGREEMENTS
- 8.2 EDIT(PSGP,PSGORD,PROMPT)^PSJOE REFERENCED BY
- 8.3 EDIT(PSGP,PSGORD,PROMPT)^PSJOE REFERS TO
- 8.4 EDIT(PSGP,PSGORD,PROMPT)^PSJOE CALLED BY
- 8.5 EDIT(PSGP,PSGORD,PROMPT)^PSJOE CALLS
- 8.6 EDIT(PSGP,PSGORD,PROMPT)^PSJOE LOCKS
- 8.7 EDIT(PSGP,PSGORD,PROMPT)^PSJOE LOCALS
- 8.8 EDIT(PSGP,PSGORD,PROMPT)^PSJOE GLOBALS
- 8.9 EDIT(PSGP,PSGORD,PROMPT)^PSJOE CODE
- 9 RENEW(PSGP,PSGORD)^PSJOE
- 9.1 RENEW(PSGP,PSGORD)^PSJOE INTEGRATION AGREEMENTS
- 9.2 RENEW(PSGP,PSGORD)^PSJOE REFERENCED BY
- 9.3 RENEW(PSGP,PSGORD)^PSJOE REFERS TO
- 9.4 RENEW(PSGP,PSGORD)^PSJOE CALLED BY
- 9.5 RENEW(PSGP,PSGORD)^PSJOE CALLS
- 9.6 RENEW(PSGP,PSGORD)^PSJOE LOCKS
- 9.7 RENEW(PSGP,PSGORD)^PSJOE LOCALS
- 9.8 RENEW(PSGP,PSGORD)^PSJOE GLOBALS
- 9.9 RENEW(PSGP,PSGORD)^PSJOE CODE
- 10 GTSTATUS(DFN,ON)^PSJOE
- 10.1 GTSTATUS(DFN,ON)^PSJOE INTEGRATION AGREEMENTS
- 10.2 GTSTATUS(DFN,ON)^PSJOE REFERENCED BY
- 10.3 GTSTATUS(DFN,ON)^PSJOE REFERS TO
- 10.4 GTSTATUS(DFN,ON)^PSJOE CALLED BY
- 10.5 GTSTATUS(DFN,ON)^PSJOE CALLS
- 10.6 GTSTATUS(DFN,ON)^PSJOE LOCKS
- 10.7 GTSTATUS(DFN,ON)^PSJOE LOCALS
- 10.8 GTSTATUS(DFN,ON)^PSJOE GLOBALS
- 10.9 GTSTATUS(DFN,ON)^PSJOE CODE
- 11 DC(DFN,PSJORD)^PSJOE
- 11.1 DC(DFN,PSJORD)^PSJOE INTEGRATION AGREEMENTS
- 11.2 DC(DFN,PSJORD)^PSJOE REFERENCED BY
- 11.3 DC(DFN,PSJORD)^PSJOE REFERS TO
- 11.4 DC(DFN,PSJORD)^PSJOE CALLED BY
- 11.5 DC(DFN,PSJORD)^PSJOE CALLS
- 11.6 DC(DFN,PSJORD)^PSJOE LOCKS
- 11.7 DC(DFN,PSJORD)^PSJOE LOCALS
- 11.8 DC(DFN,PSJORD)^PSJOE GLOBALS
- 11.9 DC(DFN,PSJORD)^PSJOE CODE
- 12 HOLD(DFN,PSJORD)^PSJOE
- 12.1 HOLD(DFN,PSJORD)^PSJOE INTEGRATION AGREEMENTS
- 12.2 HOLD(DFN,PSJORD)^PSJOE REFERENCED BY
- 12.3 HOLD(DFN,PSJORD)^PSJOE REFERS TO
- 12.4 HOLD(DFN,PSJORD)^PSJOE CALLED BY
- 12.5 HOLD(DFN,PSJORD)^PSJOE CALLS
- 12.6 HOLD(DFN,PSJORD)^PSJOE LOCKS
- 12.7 HOLD(DFN,PSJORD)^PSJOE LOCALS
- 12.8 HOLD(DFN,PSJORD)^PSJOE GLOBALS
- 12.9 HOLD(DFN,PSJORD)^PSJOE CODE
- 13 COPY(PSGP,PSGORD)^PSJOE
- 13.1 COPY(PSGP,PSGORD)^PSJOE INTEGRATION AGREEMENTS
- 13.2 COPY(PSGP,PSGORD)^PSJOE REFERENCED BY
- 13.3 COPY(PSGP,PSGORD)^PSJOE REFERS TO
- 13.4 COPY(PSGP,PSGORD)^PSJOE CALLED BY
- 13.5 COPY(PSGP,PSGORD)^PSJOE CALLS
- 13.6 COPY(PSGP,PSGORD)^PSJOE LOCKS
- 13.7 COPY(PSGP,PSGORD)^PSJOE LOCALS
- 13.8 COPY(PSGP,PSGORD)^PSJOE GLOBALS
- 13.9 COPY(PSGP,PSGORD)^PSJOE CODE
- 14 UPDATE^PSJOE
- 15 FINISH^PSJOE
- 16 LOG(DFN,PSGORD)^PSJOE
- 16.1 LOG(DFN,PSGORD)^PSJOE INTEGRATION AGREEMENTS
- 16.2 LOG(DFN,PSGORD)^PSJOE REFERENCED BY
- 16.3 LOG(DFN,PSGORD)^PSJOE REFERS TO
- 16.4 LOG(DFN,PSGORD)^PSJOE CALLED BY
- 16.5 LOG(DFN,PSGORD)^PSJOE CALLS
- 16.6 LOG(DFN,PSGORD)^PSJOE LOCKS
- 16.7 LOG(DFN,PSGORD)^PSJOE LOCALS
- 16.8 LOG(DFN,PSGORD)^PSJOE GLOBALS
- 16.9 LOG(DFN,PSGORD)^PSJOE CODE
- 17 NEWSEL^PSJOE
- 18 HOLDHDR^PSJOE
- 19 LOCKERR^PSJOE
- 20 FLAG(DFN,PSJORD)^PSJOE
- 20.1 FLAG(DFN,PSJORD)^PSJOE INTEGRATION AGREEMENTS
- 20.2 FLAG(DFN,PSJORD)^PSJOE REFERENCED BY
- 20.3 FLAG(DFN,PSJORD)^PSJOE REFERS TO
- 20.4 FLAG(DFN,PSJORD)^PSJOE CALLED BY
- 20.5 FLAG(DFN,PSJORD)^PSJOE CALLS
- 20.6 FLAG(DFN,PSJORD)^PSJOE LOCKS
- 20.7 FLAG(DFN,PSJORD)^PSJOE LOCALS
- 20.8 FLAG(DFN,PSJORD)^PSJOE GLOBALS
- 20.9 FLAG(DFN,PSJORD)^PSJOE CODE
- 21 COMPLEX(DFN,ON)^PSJOE
- 21.1 COMPLEX(DFN,ON)^PSJOE INTEGRATION AGREEMENTS
- 21.2 COMPLEX(DFN,ON)^PSJOE REFERENCED BY
- 21.3 COMPLEX(DFN,ON)^PSJOE REFERS TO
- 21.4 COMPLEX(DFN,ON)^PSJOE CALLED BY
- 21.5 COMPLEX(DFN,ON)^PSJOE CALLS
- 21.6 COMPLEX(DFN,ON)^PSJOE LOCKS
- 21.7 COMPLEX(DFN,ON)^PSJOE LOCALS
- 21.8 COMPLEX(DFN,ON)^PSJOE GLOBALS
- 21.9 COMPLEX(DFN,ON)^PSJOE CODE
ROUTINE PSJOE
PSJOE * * 207 LINES, 10479 BYTES, RSUM: 26486001/88572395 Page 1 UCI: EHR,EHR Site: Central Regional Hospital MAY 18,2015@15:41
PSJOE^PSJOE
PSJOE^PSJOE INTEGRATION AGREEMENTS
PSJOE^PSJOE REFERENCED BY
PSJOE^PSJOE REFERS TO
PSJOE^PSJOE CALLED BY
PSJOE^PSJOE CALLS
PSJOE^PSJOE LOCKS
PSJOE^PSJOE LOCALS
PSJOE^PSJOE GLOBALS
PSJOE^PSJOE CODE
1 PSJOE ;BIR/MLM-INPATIENT ORDER ENTRY ;23 Jun 98 / 1:46 PM 2 +1 ;;5.0; INPATIENT MEDICATIONS ;**7,26,29,33,42,50,56,72,58,85,95,80, 110,111,133,140,151,149,181,LOCAL,CRH**;16 DEC 97;Build 190;CRH 20 13 3 +2 ; 4 +3 ; Reference to ^PS(55 is supported by DBIA #2191. 5 +4 ; Reference to EN^VALM is supported by DBIA #10118. 6 +5 ; Reference to FULL^VALM1 and PAUSE^VALM1 is supported by DBIA #101 16. 7 +6 ; Reference to ^PSSLOCK is supported by DBIA #2789 8 +7 ; Reference to ^DPT is supported by DBIA #10035. 9 +8 ; Reference to ^ORCFLAG is supported by DBIA #3620. 10 +9 ; Reference to ^SDAMA203 is supported by DBIA #4133. 11 +10 ;
EN^PSJOE
EN^PSJOE INTEGRATION AGREEMENTS
EN^PSJOE REFERENCED BY
EN^PSJOE REFERS TO
EN^PSJOE CALLED BY
EN^PSJOE CALLS
EN^PSJOE LOCKS
EN^PSJOE LOCALS
EN^PSJOE GLOBALS
EN^PSJOE CODE
12 EN ; Start Inpatient LM OE 13 +1 N PSJLK,PSJNEWOE,PSJLMCON,PSJPROT,XQORS,VALMEVL D ENCV^PSGSETU,^PSI VXU 14 +2 I $D(XQUIT) K XQUIT G DONE 15 +3 K PSGVBY,PSJPR S (PSJOL,PSJACOK,PSGOP,PSGNEF,PSGOEAV,PSGPXN)="" L + ^PS(53.45,PSJSYSP):1 E D LOCKERR^PSJOE G DONE^PSJOE 16 +4 F S (PSJLMCON,PSGPTMP)=0 D ^PSJP,HK Q:PSGP'>0 S PSJPROT=3,DFN=PSG P D ^PSJAC D I PSJLK D UL^PSSLOCK(PSGP) 17 +5 .K ^TMP("PSJ",$J) 18 +6 .S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q 19 +7 .K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO") 20 +8 .N NXTPT S NXTPT=0 F Q:$G(NXTPT) D 21 +9 ..K PSGRDTX 22 +10 ..I $G(PSJLMCON)!$G(PSJNEWOE) D 23 +11 ...S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S") 24 +12 ...S PSJLMPRO=1,PSJLMCON=1,PSJNEWOE=0 D EN^VALM("PSJ LM OE") 25 +13 ..I $G(PSJNEWOE)!($G(VALMBCK)="Q") S PSJNEWOE=0 Q 26 +14 ..I $G(PSJLMCON)&$G(PSJLMPRO)&'$D(^TMP("PSJ",$J)) D Q 27 +15 ...S PSJLMCON=0,PSJLMPRO=0 D EN^VALM("PSJ LM BRIEF PATIENT INFO") 28 +16 ...I $G(PSJNEWOE) S NXTPT=0 Q 29 +17 ...S NXTPT=1 30 +18 ..S NXTPT=1,PSJNEWOE=0 31 +19 .S PSJOL="S" 32 +20 .I $G(PSGPXN) I $P(PSJSYSW0,U,29)]""!($G(PSJCOM)) S PSGPXPT=PSGP D K PSGPXPT S PSGPXN=0 33 +21 ..N DFN,PSGP,PSJPXDP 34 +22 ..I $P(PSJSYSW0,U,29)="" S PSJPDXP=1 D 35 +23 ...;N IO,ION,IOS D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS) 36 +24 ...D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS) 37 +25 ..S (PSGP,DFN)=PSGPXPT D ^PSGPER S:$G(PSJPDXP) $P(PSJSYSW0,U,29)="" K PSJPDXP 38 +26 .D ENCV^PSGSETU,^PSIVXU 39 +27 K PSJLMPRO,^TMP("PSJPRO",$J),^TMP("PSJ",$J),^TMP("PSJON",$J)
DONE^PSJOE
DONE^PSJOE INTEGRATION AGREEMENTS
DONE^PSJOE REFERENCED BY
DONE^PSJOE REFERS TO
DONE^PSJOE CALLED BY
DONE^PSJOE CALLS
DONE^PSJOE LOCKS
DONE^PSJOE LOCALS
DONE^PSJOE GLOBALS
DONE^PSJOE CODE
40 DONE ; 41 +1 K PSJEXCPT,PSJOCER,^TMP($J,"PSJPRE") 42 +2 K AC,ACTION,D1,D2,MI,N,ON,P3,PNOW,PSIVAT,PSIVLN,PSIVSTR L -^PS(53.4 5,PSJSYSP) 43 +3 K DA,DRG,NE,PSGCF,PSGCANFL,PSGNEDFD,PSGNEF,PSGNEFD,PSGNEPR,PSGNESD, PSJACOK,PSJOE,PSJOECNT,PSJOEPF,PSJORD,PSGOEA,PSGOEAV,PSGOL,PSGOS,P SGON,PSGOP,PSGORD,PSGS0XT,PSGS0Y,RCT,ST,WD,XREF,Z,PSJIVORF,PSJIVPC L 44 +4 K PSGOEORF,PSIVREA,PSJOPC,PSJORL,PSJORPCL,PSJORTOI,RF,WSCHADM,PSJLM ,PSJCT 45 +5 K DIU,DRGI,FLAG,FQC,ND2,PRI,PSGOE,PSGPRI,PSGSDN,PSGOEDMR,PSGOEPR,PS GPTS,PSGTOL,PSGTOO,PSGUOW,PSJIVOF,PSJOCNT,PSJON,PSJORQF,PSJORTOU,P SJORVP 46 +6 G:$G(PSGPXN) ^PSGPER1 D ENIVKV^PSGSETU 47 +7 Q
HK^PSJOE
HK^PSJOE INTEGRATION AGREEMENTS
HK^PSJOE REFERENCED BY
HK^PSJOE REFERS TO
HK^PSJOE CALLED BY
HK^PSJOE CALLS
HK^PSJOE LOCKS
HK^PSJOE LOCALS
HK^PSJOE GLOBALS
HK^PSJOE CODE
48 HK ; Housekeeping (a nice COBOL term) 49 +1 I PSGOP,PSGOP'=PSGP D 50 +2 .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP 51 +3 .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 D WP^PSJAC D:$ P(PSJSYSL,"^",2)]"" ENQL^PSGLW 52 +4 Q:PSGP<0 53 +5 S (DFN,PSGOP)=PSGP,X="" 54 +6 Q
SELECT^PSJOE
SELECT^PSJOE INTEGRATION AGREEMENTS
SELECT^PSJOE REFERENCED BY
SELECT^PSJOE REFERS TO
SELECT^PSJOE CALLED BY
SELECT^PSJOE CALLS
SELECT^PSJOE LOCKS
SELECT^PSJOE LOCALS
SELECT^PSJOE GLOBALS
SELECT^PSJOE CODE
55 SELECT ; Select order from list 56 +1 ;Variable PSJOCDSC is used in Complex order dosing checks 57 +2 N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX,PSJOCDSC K ^TMP( "PSJCOM",$J),^TMP("PSJCOM2",$J) 58 +3 S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON 59 +4 I "^"[X S VALMQUIT=1 Q 60 +5 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 61 +6 .K PSJOCDSC 62 +7 .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:P SJORD=+PSJORD SELECT^PSJOEA Q:PSJORD=""!($G(Y)<0) Q:PSJORD=+PSJOR D D 63 +8 ..Q:('$$LS^PSSLOCK(PSGP,PSJORD)) 64 +9 ..Q:PSJORD=+PSJORD 65 +10 ..S PSGORD="" 66 +11 ..D DISACTIO(PSGP,PSJORD,"") S:PSJORD["V" PSJORD=ON 67 +12 ..D UNL^PSSLOCK(PSGP,PSJORD) Q:$G(Y)<0 68 +13 S VALMBCK="Q" 69 +14 K PSJLM,PSJOCDSC 70 +15 Q
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE INTEGRATION AGREEMENTS
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE REFERENCED BY
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE REFERS TO
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE CALLED BY
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE CALLS
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE LOCKS
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE LOCALS
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE GLOBALS
DISACTIO(DFN,PSJORD,PSJPNV)^PSJOE CODE
71 DISACTIO(DFN,PSJORD,PSJPNV) -- ; Display UD order and allow actions. 72 +1 ; PSJORD - Order #_location Code (P:53.1,V:55.01,U:55.06) 73 +2 ; PSJPNV - Invoked from Pending/NV option; (gets different hidden m enu) 74 +3 N PSGP,PSJIVFLG,PSGSDX,PSGFDX,PSJXX1,ON55 75 +4 D OLDCOM^PSJOE0(DFN,PSJORD) 76 +5 S PSGP=DFN D ENIV^PSJAC I PSJORD["V" D EN^PSJLIORD(DFN,PSJORD) Q 77 +6 D GETUD^PSJLMGUD(DFN,PSJORD) 78 +7 S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU 79 +8 S:$G(PSJTUD) PSGPD=$G(PSJCOI),PSGPDN=$$OINAME^PSJLMUTL(+PSGPD) 80 +9 K PSGOENG I '$D(PSGPRF) D Q:$G(PSGOENG) 81 +10 . I PSJORD["U" L +^PS(55,PSGP,5,+PSJORD):1 E S PSGOENG=1 82 +11 . I PSJORD["P" L +^PS(53.1,+PSJORD):1 E S PSGOENG=1 83 +12 . ;LOCAL MOD DJW 10/2013 - Make message unique 84 +13 . ; include NON VERIFIED ORDER number in message 85 +14 . ;I $G(PSGOENG) W !,"This order is being edited by another termina l.",! S PSGOENG=1 K DIR S DIR(0)="E" D ^DIR K DIR Q 86 +15 . I $G(PSGOENG) D Q 87 +16 .. W !,"This order "_$S(PSJORD["U":"UD#",1:"NVO#")_+PSJORD_" is bei ng edited by a different terminal.",! 88 +17 .. S PSGOENG=1 K DIR S DIR(0)="E" D ^DIR K DIR Q 89 +18 . ;END LOCAL MOD DJW 10/2013 90 +19 S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD) 91 +20 I PSJORD["P" S PSJXX1=$G(^PS(53.1,+PSJORD,0)) I PSGP'=$P(PSJXX1,U,1 5)!(DFN'=$P(PSJXX1,U,15)) L -^PS(53.1,+PSJORD) Q 92 +21 I PSJORD["P" D S PSJXX1=$P($G(^PS(53.1,+PSJORD,0)),U,9) I $S($G(PS JIVFLG):1,$G(Y)<0:1,"PADE"[PSJXX1:1,1:0) L -^PS(53.1,+PSJORD) Q 93 +22 .I $P(PSJXX1,U,9)="N",($P(PSJXX1,U,4)'="U") D Q 94 +23 .. S P("PON")=PSJORD,PSIVFLG=1 95 +24 .. N ON S ON=PSJORD D VF^PSIVORC2 96 +25 .I $P(PSJXX1,U,9)="P" D Q 97 +26 ..S:$G(PSJTUD) $P(PSJXX1,U,4)="U" 98 +27 ..I $P(PSJXX1,U,4)="U" D Q:$G(PSJIVFLG) 99 +28 ... N VAIP S CLINIC=$G(^PS(53.1,+PSJORD,"DSS")),APPT=$P(CLINIC,"^", 2),CLINIC=$P(CLINIC,"^") I $$PATCH^XPDUTL("SD*5.3*285"),$$SDIMO^SD AMA203(CLINIC,DFN)>-1 Q 100 +29 ... Q:'PSJPDD W !!,"Cannot process an Out-patient Unit Dose order for ",$P($G(^DPT(+PSGP,0)),U) D PAUSE^VALM1 S PSJIVFLG=1 101 +30 ..NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN 102 +31 ..D REQDT^PSJLIVMD(PSJORD) 103 +32 ..I $P(PSJXX1,U,4)="U",($G(PSGSCH)="") W !!,"Invalid schedule, can' t finish this order" D PAUSE^VALM1 Q 104 +33 ..I $P(PSJXX1,U,4)="U" N PSJLM S PSJLM=1,PSGORD=PSJORD D START^PSGO EF,ENSFE^PSGOEE0(PSGP,PSGORD),@$S($G(PSJTUD):"FINISH^PSGOEF",1:"EN ^VALM(""PSJ LM PENDING EDIT"")") Q 105 +34 ..I $P(PSJXX1,U,4)'="U",PSGP=$P(PSJXX1,U,15),DFN=$P(PSJXX1,U,15) S PSJLYN=PSJORD D EN^PSJLIFN S PSJIVFLG=1 K PSJLYN,PSJMAI 106 +35 I $G(PSIVFLG) K PSIVFLG Q 107 +36 S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD),PSGOEEF=0 D GETUD^PSJLMGUD( PSGP,PSJORD),ENSFE^PSGOEE0(PSGP,PSJORD),EN^VALM("PSJ LM UD ACTION" ) 108 +37 I PSJORD["P" L -^PS(53.1,+PSJORD) 109 +38 I PSJORD["U" L -^PS(55,PSGP,5,+PSJORD) 110 +39 ;Send SN to CPRS if auto-verify OFF and Order Set Entry and no 21st piece 111 +40 S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU 112 +41 I $D(PSGOES),'PSGOEAV,$D(PSGORD),PSGORD["P",$P($G(^PS(53.1,+PSGORD, 0)),"^",21)']"" D ORSET^PSGOETO1 113 +42 D UNL^PSSLOCK(PSGP,PSJORD) 114 +43 Q
EDIT(PSGP,PSGORD,PROMPT)^PSJOE
EDIT(PSGP,PSGORD,PROMPT)^PSJOE INTEGRATION AGREEMENTS
EDIT(PSGP,PSGORD,PROMPT)^PSJOE REFERENCED BY
EDIT(PSGP,PSGORD,PROMPT)^PSJOE REFERS TO
EDIT(PSGP,PSGORD,PROMPT)^PSJOE CALLED BY
EDIT(PSGP,PSGORD,PROMPT)^PSJOE CALLS
EDIT(PSGP,PSGORD,PROMPT)^PSJOE LOCKS
EDIT(PSGP,PSGORD,PROMPT)^PSJOE LOCALS
EDIT(PSGP,PSGORD,PROMPT)^PSJOE GLOBALS
EDIT(PSGP,PSGORD,PROMPT)^PSJOE CODE
115 EDIT(PSGP,PSGORD,PROMPT) -- ; 116 +1 I "DE"[$$GTSTATUS(PSGP,PSGORD) W !,"This order may not be edited." D PAUSE^VALM1 Q 117 +2 I PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q 118 +3 S PSGNEDFD="" D HOLDHDR,@$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") I 'Y D ABORT^PSGOEE Q 119 +4 I PSGORD["P" D ENF^PSGOEE Q 120 +5 D ACT^PSGOEE 121 +6 Q
RENEW(PSGP,PSGORD)^PSJOE
RENEW(PSGP,PSGORD)^PSJOE INTEGRATION AGREEMENTS
RENEW(PSGP,PSGORD)^PSJOE REFERENCED BY
RENEW(PSGP,PSGORD)^PSJOE REFERS TO
RENEW(PSGP,PSGORD)^PSJOE CALLED BY
RENEW(PSGP,PSGORD)^PSJOE CALLS
RENEW(PSGP,PSGORD)^PSJOE LOCKS
RENEW(PSGP,PSGORD)^PSJOE LOCALS
RENEW(PSGP,PSGORD)^PSJOE GLOBALS
RENEW(PSGP,PSGORD)^PSJOE CODE
122 RENEW(PSGP,PSGORD) -- ; 123 +1 D HOLDHDR 124 +2 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 V ALMBCK="R" Q 125 +3 I 'PSGRRF D ^PSGOER Q 126 +4 D ^PSGOERI 127 +5 Q
GTSTATUS(DFN,ON)^PSJOE
GTSTATUS(DFN,ON)^PSJOE INTEGRATION AGREEMENTS
GTSTATUS(DFN,ON)^PSJOE REFERENCED BY
GTSTATUS(DFN,ON)^PSJOE REFERS TO
GTSTATUS(DFN,ON)^PSJOE CALLED BY
GTSTATUS(DFN,ON)^PSJOE CALLS
GTSTATUS(DFN,ON)^PSJOE LOCKS
GTSTATUS(DFN,ON)^PSJOE LOCALS
GTSTATUS(DFN,ON)^PSJOE GLOBALS
GTSTATUS(DFN,ON)^PSJOE CODE
128 GTSTATUS(DFN,ON) -- ; 129 +1 I ON["P" Q $P($G(^PS(53.1,+ON,0)),U,9) 130 +2 I ON["U" Q $P($G(^PS(55,DFN,5,+ON,0)),U,9) 131 +3 Q $P($G(^PS(55,DFN,"IV",+ON,0)),U,17)
DC(DFN,PSJORD)^PSJOE
DC(DFN,PSJORD)^PSJOE INTEGRATION AGREEMENTS
DC(DFN,PSJORD)^PSJOE REFERENCED BY
DC(DFN,PSJORD)^PSJOE REFERS TO
DC(DFN,PSJORD)^PSJOE CALLED BY
DC(DFN,PSJORD)^PSJOE CALLS
DC(DFN,PSJORD)^PSJOE LOCKS
DC(DFN,PSJORD)^PSJOE LOCALS
DC(DFN,PSJORD)^PSJOE GLOBALS
DC(DFN,PSJORD)^PSJOE CODE
132 DC(DFN,PSJORD) -- ; DC IV, UD, or pending orders. 133 +1 D HOLDHDR 134 +2 S X=$$GTSTATUS(DFN,PSJORD) I X="D"!(X="DE")!(X="R") W !,$S(X="R":"T his order has a pending renewal and cannot be DISCONTINUED.",1:"Th is order has already been DISCONTINUED.") D PAUSE^VALM1 Q 135 +3 D ENO^PSGOEC(DFN,PSJORD) ;,GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE (DFN,PSJORD) S VALMBCK="Q" 136 +4 S VALMBCK="Q" 137 +5 Q
HOLD(DFN,PSJORD)^PSJOE
HOLD(DFN,PSJORD)^PSJOE INTEGRATION AGREEMENTS
HOLD(DFN,PSJORD)^PSJOE REFERENCED BY
HOLD(DFN,PSJORD)^PSJOE REFERS TO
HOLD(DFN,PSJORD)^PSJOE CALLED BY
HOLD(DFN,PSJORD)^PSJOE CALLS
HOLD(DFN,PSJORD)^PSJOE LOCKS
HOLD(DFN,PSJORD)^PSJOE LOCALS
HOLD(DFN,PSJORD)^PSJOE GLOBALS
HOLD(DFN,PSJORD)^PSJOE CODE
138 HOLD(DFN,PSJORD) -- ; Change order's status from ACTIVE<->HOLD 139 +1 D HOLDHDR 140 +2 I PSJORD["V" D H^PSIVOPT(DFN,PSJORD,P(17),P(3)) 141 +3 I PSJORD'["V" D H^PSGOE1(DFN,PSJORD) 142 +4 D GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S PSGACT=$$E NACTION^PSGOE1(DFN,PSJORD),VALMBCK="R" 143 +5 Q
COPY(PSGP,PSGORD)^PSJOE
COPY(PSGP,PSGORD)^PSJOE INTEGRATION AGREEMENTS
COPY(PSGP,PSGORD)^PSJOE REFERENCED BY
COPY(PSGP,PSGORD)^PSJOE REFERS TO
COPY(PSGP,PSGORD)^PSJOE CALLED BY
COPY(PSGP,PSGORD)^PSJOE CALLS
COPY(PSGP,PSGORD)^PSJOE LOCKS
COPY(PSGP,PSGORD)^PSJOE LOCALS
COPY(PSGP,PSGORD)^PSJOE GLOBALS
COPY(PSGP,PSGORD)^PSJOE CODE
144 COPY(PSGP,PSGORD) -- ; Copy an order (does not discontinue original order) 145 +1 I $D(PSGCOPY) W !!,"You cannot copy the order at this time" D PAUSE ^VALM1 Q 146 +2 I PSGORD["P" W !!,"You cannot copy this "_$S($G(PSGSTAT)]"":PSGSTAT ,1:"PENDING IV")_" order." D PAUSE^VALM1 Q 147 +3 I PSGORD["V" D Q 148 +4 .I $G(PSIVCOPY) W !!,"You cannot copy the order at this time" D PAU SE^VALM1 Q 149 +5 .D COPY^PSIVOD(PSGP,PSGORD) Q 150 +6 Q:'$$HIDDEN^PSJLMUTL("COPY") 151 +7 D ^PSJHVARS 152 +8 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 153 +9 S PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU 154 +10 S PSGCOPY=1 155 +11 D FULL^VALM1,^PSGOD 156 +12 S VALMBCK="R" 157 +13 K PSGCOPY 158 +14 S PSGACT=$$ENACTION^PSGOE1(PSGP,PSGORD) ; resets PSGACT after copy 159 +15 I $G(PSGPXN) N PSGTMPXN S PSGTMPXN=PSGPXN 160 +16 D RESTORE^PSJHVARS I $G(PSGTMPXN) S PSGPXN=PSGTMPXN 161 +17 Q
UPDATE^PSJOE
UPDATE^PSJOE INTEGRATION AGREEMENTS
UPDATE^PSJOE REFERENCED BY
UPDATE^PSJOE REFERS TO
UPDATE^PSJOE CALLED BY
UPDATE^PSJOE CALLS
UPDATE^PSJOE LOCKS
UPDATE^PSJOE LOCALS
UPDATE^PSJOE GLOBALS
UPDATE^PSJOE CODE
162 UPDATE ; Refresh array, actions, & display. 163 +1 D GETUD^PSJLMGUD(DFN,ON),INIT^PSJLMUDE(DFN,ON) S VALMBCK="R" 164 +2 Q
FINISH^PSJOE
FINISH^PSJOE INTEGRATION AGREEMENTS
FINISH^PSJOE REFERENCED BY
FINISH^PSJOE REFERS TO
FINISH^PSJOE CALLED BY
FINISH^PSJOE CALLS
FINISH^PSJOE LOCKS
FINISH^PSJOE LOCALS
FINISH^PSJOE GLOBALS
FINISH^PSJOE CODE
165 FINISH ; 166 +1 D FINISH^PSGOEF,PAUSE^VALM1 167 +2 Q
LOG(DFN,PSGORD)^PSJOE
LOG(DFN,PSGORD)^PSJOE INTEGRATION AGREEMENTS
LOG(DFN,PSGORD)^PSJOE REFERENCED BY
LOG(DFN,PSGORD)^PSJOE REFERS TO
LOG(DFN,PSGORD)^PSJOE CALLED BY
LOG(DFN,PSGORD)^PSJOE CALLS
LOG(DFN,PSGORD)^PSJOE LOCKS
LOG(DFN,PSGORD)^PSJOE LOCALS
LOG(DFN,PSGORD)^PSJOE GLOBALS
LOG(DFN,PSGORD)^PSJOE CODE
168 LOG(DFN,PSGORD) -- ; 169 +1 D FULL^VALM1,ENLM^PSGOEL(DFN,PSGORD),PAUSE^VALM1 S VALMBCK="R" 170 +2 Q
NEWSEL^PSJOE
NEWSEL^PSJOE INTEGRATION AGREEMENTS
NEWSEL^PSJOE REFERENCED BY
NEWSEL^PSJOE REFERS TO
NEWSEL^PSJOE CALLED BY
NEWSEL^PSJOE CALLS
NEWSEL^PSJOE LOCKS
NEWSEL^PSJOE LOCALS
NEWSEL^PSJOE GLOBALS
NEWSEL^PSJOE CODE
171 NEWSEL ; 172 +1 N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX,PSJOCDSC K ^TMP( "PSJCOM",$J),^TMP("PSJCOM2",$J) 173 +2 S X=$P(XQORNOD(0),"=",2) 174 +3 S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0) 175 +4 D ENCHK^PSGON I '$O(PSGODDD(0)) S VALMQUIT=1 Q 176 +5 S PSJLM=1,PSJSEL=0 F S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL F PSJ SEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D 177 +6 .K PSJOCDSC 178 +7 .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:P SJORD=+PSJORD SELECT^PSJOEA 179 +8 .Q:PSJORD=+PSJORD 180 +9 .Q:PSJORD=""!($G(Y)<0) Q:('$$LS^PSSLOCK(PSGP,PSJORD)) D 181 +10 ..S PSGORD="" 182 +11 ..S ON=PSJORD 183 +12 ..D DISACTIO(PSGP,PSJORD,$G(PSJPNV)) S:PSJORD["V" PSJORD=ON 184 +13 ..D UNL^PSSLOCK(PSGP,PSJORD) 185 +14 ..I $G(PSJNOL) K PSJNOL I $D(ON),ON'=PSJORD D UNL^PSSLOCK(PSGP,ON) 186 +15 ..Q:$G(Y)<0 187 +16 S VALMBCK="Q" 188 +17 K PSJLM,PSJOCDSC 189 +18 Q
HOLDHDR^PSJOE
HOLDHDR^PSJOE INTEGRATION AGREEMENTS
HOLDHDR^PSJOE REFERENCED BY
HOLDHDR^PSJOE REFERS TO
HOLDHDR^PSJOE CALLED BY
HOLDHDR^PSJOE CALLS
HOLDHDR^PSJOE LOCKS
HOLDHDR^PSJOE LOCALS
HOLDHDR^PSJOE GLOBALS
HOLDHDR^PSJOE CODE
190 HOLDHDR ; Freeze header text while processing order actions 191 +1 I $D(VALM("TM")) S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IOR C 192 +2 Q
LOCKERR^PSJOE
LOCKERR^PSJOE INTEGRATION AGREEMENTS
LOCKERR^PSJOE REFERENCED BY
LOCKERR^PSJOE REFERS TO
LOCKERR^PSJOE CALLED BY
LOCKERR^PSJOE CALLS
LOCKERR^PSJOE LOCKS
LOCKERR^PSJOE LOCALS
LOCKERR^PSJOE GLOBALS
LOCKERR^PSJOE CODE
193 LOCKERR ; 194 +1 W !!,$C(7),"You are entering or editing an Inpatient Medication ord er in another session.",!,"Only one order entry/edit session is al lowed for a user at a time.",!! N DIR S DIR(0)="E" D ^DIR 195 +2 Q
FLAG(DFN,PSJORD)^PSJOE
FLAG(DFN,PSJORD)^PSJOE INTEGRATION AGREEMENTS
FLAG(DFN,PSJORD)^PSJOE REFERENCED BY
FLAG(DFN,PSJORD)^PSJOE REFERS TO
FLAG(DFN,PSJORD)^PSJOE CALLED BY
FLAG(DFN,PSJORD)^PSJOE CALLS
FLAG(DFN,PSJORD)^PSJOE LOCKS
FLAG(DFN,PSJORD)^PSJOE LOCALS
FLAG(DFN,PSJORD)^PSJOE GLOBALS
FLAG(DFN,PSJORD)^PSJOE CODE
196 FLAG(DFN,PSJORD) -- ;Flag order through CPRS entry point. 197 +1 N ORIFN,NODE0 198 +2 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)) 199 +3 S ORIFN=$P(NODE0,"^",21) 200 +4 D EN1^ORCFLAG(ORIFN) 201 +5 D PAUSE^VALM1 202 +6 Q
COMPLEX(DFN,ON)^PSJOE
COMPLEX(DFN,ON)^PSJOE INTEGRATION AGREEMENTS
COMPLEX(DFN,ON)^PSJOE REFERENCED BY
COMPLEX(DFN,ON)^PSJOE REFERS TO
COMPLEX(DFN,ON)^PSJOE CALLED BY
COMPLEX(DFN,ON)^PSJOE CALLS
COMPLEX(DFN,ON)^PSJOE LOCKS
COMPLEX(DFN,ON)^PSJOE LOCALS
COMPLEX(DFN,ON)^PSJOE GLOBALS
COMPLEX(DFN,ON)^PSJOE CODE
203 COMPLEX(DFN,ON) -- ; 204 +1 N NDP2,COM 205 +2 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:"") 206 +3 S COM=$P(NDP2,"^",8) I COM Q 1 207 +4 Q 0