| [613] | 1 | PSJOE ;BIR/MLM-INPATIENT ORDER ENTRY ;23 Jun 98 / 1:46 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**7,26,29,33,42,50,56,72,58,85,95,80,110,111,133,140,151,149**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA #2191.
|
|---|
| 5 | ; Reference to EN^VALM is supported by DBIA #10118.
|
|---|
| 6 | ; Reference to FULL^VALM1 and PAUSE^VALM1 is supported by DBIA #10116.
|
|---|
| 7 | ; Reference to ^PSSLOCK is supported by DBIA #2789
|
|---|
| 8 | ; Reference to ^DPT is supported by DBIA #10035.
|
|---|
| 9 | ; Reference to ^ORCFLAG is supported by DBIA #3620.
|
|---|
| 10 | ; Reference to ^SDAMA203 is supported by DBIA #4133.
|
|---|
| 11 | ;
|
|---|
| 12 | EN ; Start Inpatient LM OE
|
|---|
| 13 | N PSJLK,PSJNEWOE,PSJLMCON,PSJPROT,XQORS,VALMEVL D ENCV^PSGSETU,^PSIVXU
|
|---|
| 14 | I $D(XQUIT) K XQUIT G DONE
|
|---|
| 15 | K PSGVBY,PSJPR S (PSJOL,PSJACOK,PSGOP,PSGNEF,PSGOEAV,PSGPXN)="" L +^PS(53.45,PSJSYSP):1 E D LOCKERR^PSJOE G DONE^PSJOE
|
|---|
| 16 | 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)
|
|---|
| 17 | .K ^TMP("PSJ",$J)
|
|---|
| 18 | .S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q
|
|---|
| 19 | .K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO")
|
|---|
| 20 | .N NXTPT S NXTPT=0 F Q:$G(NXTPT) D
|
|---|
| 21 | ..K PSGRDTX
|
|---|
| 22 | ..I $G(PSJLMCON)!$G(PSJNEWOE) D
|
|---|
| 23 | ...S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
|
|---|
| 24 | ...S PSJLMPRO=1,PSJLMCON=1,PSJNEWOE=0 D EN^VALM("PSJ LM OE")
|
|---|
| 25 | ..I $G(PSJNEWOE)!($G(VALMBCK)="Q") S PSJNEWOE=0 Q
|
|---|
| 26 | ..I $G(PSJLMCON)&$G(PSJLMPRO)&'$D(^TMP("PSJ",$J)) D Q
|
|---|
| 27 | ...S PSJLMCON=0,PSJLMPRO=0 D EN^VALM("PSJ LM BRIEF PATIENT INFO")
|
|---|
| 28 | ...I $G(PSJNEWOE) S NXTPT=0 Q
|
|---|
| 29 | ...S NXTPT=1
|
|---|
| 30 | ..S NXTPT=1,PSJNEWOE=0
|
|---|
| 31 | .S PSJOL="S"
|
|---|
| 32 | .I $G(PSGPXN) I $P(PSJSYSW0,U,29)]""!($G(PSJCOM)) S PSGPXPT=PSGP D K PSGPXPT S PSGPXN=0
|
|---|
| 33 | ..N DFN,PSGP,PSJPXDP
|
|---|
| 34 | ..I $P(PSJSYSW0,U,29)="" S PSJPDXP=1 D
|
|---|
| 35 | ...N IO,ION,IOS D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS)
|
|---|
| 36 | ..S (PSGP,DFN)=PSGPXPT D ^PSGPER S:$G(PSJPDXP) $P(PSJSYSW0,U,29)="" K PSJPDXP
|
|---|
| 37 | .D ENCV^PSGSETU,^PSIVXU
|
|---|
| 38 | K PSJLMPRO,^TMP("PSJPRO",$J),^TMP("PSJ",$J),^TMP("PSJON",$J)
|
|---|
| 39 | ;
|
|---|
| 40 | DONE ;
|
|---|
| 41 | K AC,ACTION,D1,D2,MI,N,ON,P3,PNOW,PSIVAT,PSIVLN,PSIVSTR L -^PS(53.45,PSJSYSP)
|
|---|
| 42 | 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
|
|---|
| 43 | K PSGOEORF,PSIVREA,PSJOPC,PSJORL,PSJORPCL,PSJORTOI,RF,WSCHADM,PSJLM,PSJCT
|
|---|
| 44 | K DIU,DRGI,FLAG,FQC,ND2,PRI,PSGOE,PSGPRI,PSGSDN,PSGOEDMR,PSGOEPR,PSGPTS,PSGTOL,PSGTOO,PSGUOW,PSJIVOF,PSJOCNT,PSJON,PSJORQF,PSJORTOU,PSJORVP
|
|---|
| 45 | G:$G(PSGPXN) ^PSGPER1 D ENIVKV^PSGSETU
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | HK ; Housekeeping (a nice COBOL term)
|
|---|
| 49 | I PSGOP,PSGOP'=PSGP D
|
|---|
| 50 | .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
|
|---|
| 51 | .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,"^",2)]"" ENQL^PSGLW
|
|---|
| 52 | Q:PSGP<0
|
|---|
| 53 | S (DFN,PSGOP)=PSGP,X=""
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | SELECT ; Select order from list
|
|---|
| 57 | N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J)
|
|---|
| 58 | S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON
|
|---|
| 59 | I "^"[X S VALMQUIT=1 Q
|
|---|
| 60 | 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 | .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA Q:PSJORD=""!($G(Y)<0) Q:PSJORD=+PSJORD D
|
|---|
| 62 | ..Q:('$$LS^PSSLOCK(PSGP,PSJORD))
|
|---|
| 63 | ..Q:PSJORD=+PSJORD
|
|---|
| 64 | ..S PSGORD=""
|
|---|
| 65 | ..D DISACTIO(PSGP,PSJORD,"") S:PSJORD["V" PSJORD=ON
|
|---|
| 66 | ..D UNL^PSSLOCK(PSGP,PSJORD) Q:$G(Y)<0
|
|---|
| 67 | S VALMBCK="Q"
|
|---|
| 68 | K PSJLM
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | DISACTIO(DFN,PSJORD,PSJPNV) ; Display UD order and allow actions.
|
|---|
| 72 | ; DFN - Patient IEN
|
|---|
| 73 | ; PSJORD - Order #_location Code (P:53.1,V:55.01,U:55.06)
|
|---|
| 74 | ; PSJPNV - Invoked from Pending/NV option; (gets different hidden menu)
|
|---|
| 75 | N PSGP,PSJIVFLG,PSGSDX,PSGFDX,PSJXX1,ON55
|
|---|
| 76 | D OLDCOM^PSJOE0(DFN,PSJORD)
|
|---|
| 77 | S PSGP=DFN D ENIV^PSJAC I PSJORD["V" D EN^PSJLIORD(DFN,PSJORD) Q
|
|---|
| 78 | D GETUD^PSJLMGUD(DFN,PSJORD)
|
|---|
| 79 | S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
|
|---|
| 80 | S:$G(PSJTUD) PSGPD=$G(PSJCOI),PSGPDN=$$OINAME^PSJLMUTL(+PSGPD)
|
|---|
| 81 | K PSGOENG I '$D(PSGPRF) D Q:$G(PSGOENG)
|
|---|
| 82 | . I PSJORD["U" L +^PS(55,PSGP,5,+PSJORD):1 E S PSGOENG=1
|
|---|
| 83 | . I PSJORD["P" L +^PS(53.1,+PSJORD):1 E S PSGOENG=1
|
|---|
| 84 | . 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
|
|---|
| 85 | S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD)
|
|---|
| 86 | 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
|
|---|
| 87 | 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
|
|---|
| 88 | .I $P(PSJXX1,U,9)="N",($P(PSJXX1,U,4)'="U") D Q
|
|---|
| 89 | .. S P("PON")=PSJORD,PSIVFLG=1
|
|---|
| 90 | .. N ON S ON=PSJORD D VF^PSIVORC2
|
|---|
| 91 | .I $P(PSJXX1,U,9)="P" D Q
|
|---|
| 92 | ..S:$G(PSJTUD) $P(PSJXX1,U,4)="U"
|
|---|
| 93 | ..I $P(PSJXX1,U,4)="U" D Q:$G(PSJIVFLG)
|
|---|
| 94 | ... 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^SDAMA203(CLINIC,DFN)>-1 Q
|
|---|
| 95 | ... Q:'PSJPDD W !!,"Cannot process an Out-patient Unit Dose order for ",$P($G(^DPT(+PSGP,0)),U) D PAUSE^VALM1 S PSJIVFLG=1
|
|---|
| 96 | ..NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
|
|---|
| 97 | ..D REQDT^PSJLIVMD(PSJORD)
|
|---|
| 98 | ..I $P(PSJXX1,U,4)="U",($G(PSGSCH)="") W !!,"Invalid schedule, can't finish this order" D PAUSE^VALM1 Q
|
|---|
| 99 | ..I $P(PSJXX1,U,4)="U" N PSJLM S PSJLM=1,PSGORD=PSJORD D START^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),@$S($G(PSJTUD):"FINISH^PSGOEF",1:"EN^VALM(""PSJ LM PENDING EDIT"")") Q
|
|---|
| 100 | ..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
|
|---|
| 101 | I $G(PSIVFLG) K PSIVFLG Q
|
|---|
| 102 | S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD),PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSJORD),ENSFE^PSGOEE0(PSGP,PSJORD),EN^VALM("PSJ LM UD ACTION")
|
|---|
| 103 | I PSJORD["P" L -^PS(53.1,+PSJORD)
|
|---|
| 104 | I PSJORD["U" L -^PS(55,PSGP,5,+PSJORD)
|
|---|
| 105 | ;Send SN to CPRS if auto-verify OFF and Order Set Entry and no 21st piece
|
|---|
| 106 | S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
|
|---|
| 107 | I $D(PSGOES),'PSGOEAV,$D(PSGORD),PSGORD["P",$P($G(^PS(53.1,+PSGORD,0)),"^",21)']"" D ORSET^PSGOETO1
|
|---|
| 108 | D UNL^PSSLOCK(PSGP,PSJORD)
|
|---|
| 109 | Q
|
|---|
| 110 | EDIT(PSGP,PSGORD,PROMPT) ;
|
|---|
| 111 | I "DE"[$$GTSTATUS(PSGP,PSGORD) W !,"This order may not be edited." D PAUSE^VALM1 Q
|
|---|
| 112 | I PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q
|
|---|
| 113 | S PSGNEDFD="" D HOLDHDR,@$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") I 'Y D ABORT^PSGOEE Q
|
|---|
| 114 | I PSGORD["P" D ENF^PSGOEE Q
|
|---|
| 115 | D ACT^PSGOEE
|
|---|
| 116 | Q
|
|---|
| 117 | RENEW(PSGP,PSGORD) ;
|
|---|
| 118 | D HOLDHDR
|
|---|
| 119 | 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
|
|---|
| 120 | I 'PSGRRF D ^PSGOER Q
|
|---|
| 121 | D ^PSGOERI
|
|---|
| 122 | Q
|
|---|
| 123 | ;
|
|---|
| 124 | GTSTATUS(DFN,ON) ;
|
|---|
| 125 | I ON["P" Q $P($G(^PS(53.1,+ON,0)),U,9)
|
|---|
| 126 | I ON["U" Q $P($G(^PS(55,DFN,5,+ON,0)),U,9)
|
|---|
| 127 | Q $P($G(^PS(55,DFN,"IV",+ON,0)),U,17)
|
|---|
| 128 | ;
|
|---|
| 129 | DC(DFN,PSJORD) ; DC IV, UD, or pending orders.
|
|---|
| 130 | D HOLDHDR
|
|---|
| 131 | 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
|
|---|
| 132 | D ENO^PSGOEC(DFN,PSJORD) ;,GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S VALMBCK="Q"
|
|---|
| 133 | S VALMBCK="Q"
|
|---|
| 134 | Q
|
|---|
| 135 | HOLD(DFN,PSJORD) ; Change order's status from ACTIVE<->HOLD
|
|---|
| 136 | D HOLDHDR
|
|---|
| 137 | I PSJORD["V" D H^PSIVOPT(DFN,PSJORD,P(17),P(3))
|
|---|
| 138 | I PSJORD'["V" D H^PSGOE1(DFN,PSJORD)
|
|---|
| 139 | D GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S PSGACT=$$ENACTION^PSGOE1(DFN,PSJORD),VALMBCK="R"
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | COPY(PSGP,PSGORD) ; Copy an order (does not discontinue original order)
|
|---|
| 143 | I $D(PSGCOPY) W !!,"You cannot copy the order at this time" D PAUSE^VALM1 Q
|
|---|
| 144 | I PSGORD["P" W !!,"You cannot copy this "_$S($G(PSGSTAT)]"":PSGSTAT,1:"PENDING IV")_" order." D PAUSE^VALM1 Q
|
|---|
| 145 | I PSGORD["V" D Q
|
|---|
| 146 | .I $G(PSIVCOPY) W !!,"You cannot copy the order at this time" D PAUSE^VALM1 Q
|
|---|
| 147 | .D COPY^PSIVOD(PSGP,PSGORD) Q
|
|---|
| 148 | Q:'$$HIDDEN^PSJLMUTL("COPY")
|
|---|
| 149 | D ^PSJHVARS
|
|---|
| 150 | 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
|
|---|
| 151 | S PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU
|
|---|
| 152 | S PSGCOPY=1
|
|---|
| 153 | D FULL^VALM1,^PSGOD
|
|---|
| 154 | S VALMBCK="R"
|
|---|
| 155 | K PSGCOPY
|
|---|
| 156 | S PSGACT=$$ENACTION^PSGOE1(PSGP,PSGORD) ; resets PSGACT after copy
|
|---|
| 157 | I $G(PSGPXN) N PSGTMPXN S PSGTMPXN=PSGPXN
|
|---|
| 158 | D RESTORE^PSJHVARS I $G(PSGTMPXN) S PSGPXN=PSGTMPXN
|
|---|
| 159 | Q
|
|---|
| 160 | ;
|
|---|
| 161 | UPDATE ; Refresh array, actions, & display.
|
|---|
| 162 | D GETUD^PSJLMGUD(DFN,ON),INIT^PSJLMUDE(DFN,ON) S VALMBCK="R"
|
|---|
| 163 | Q
|
|---|
| 164 | FINISH ;
|
|---|
| 165 | D FINISH^PSGOEF,PAUSE^VALM1
|
|---|
| 166 | Q
|
|---|
| 167 | ;
|
|---|
| 168 | LOG(DFN,PSGORD) ;
|
|---|
| 169 | D FULL^VALM1,ENLM^PSGOEL(DFN,PSGORD),PAUSE^VALM1 S VALMBCK="R"
|
|---|
| 170 | Q
|
|---|
| 171 | NEWSEL ;
|
|---|
| 172 | N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J)
|
|---|
| 173 | S X=$P(XQORNOD(0),"=",2)
|
|---|
| 174 | S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0)
|
|---|
| 175 | D ENCHK^PSGON I '$O(PSGODDD(0)) S VALMQUIT=1 Q
|
|---|
| 176 | S PSJLM=1,PSJSEL=0 F S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL F PSJSEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D
|
|---|
| 177 | .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA
|
|---|
| 178 | .Q:PSJORD=+PSJORD
|
|---|
| 179 | .Q:PSJORD=""!($G(Y)<0) Q:('$$LS^PSSLOCK(PSGP,PSJORD)) D
|
|---|
| 180 | ..S PSGORD=""
|
|---|
| 181 | ..S ON=PSJORD
|
|---|
| 182 | ..D DISACTIO(PSGP,PSJORD,$G(PSJPNV)) S:PSJORD["V" PSJORD=ON
|
|---|
| 183 | ..D UNL^PSSLOCK(PSGP,PSJORD)
|
|---|
| 184 | ..I $G(PSJNOL) K PSJNOL I $D(ON),ON'=PSJORD D UNL^PSSLOCK(PSGP,ON)
|
|---|
| 185 | ..Q:$G(Y)<0
|
|---|
| 186 | S VALMBCK="Q"
|
|---|
| 187 | K PSJLM
|
|---|
| 188 | Q
|
|---|
| 189 | HOLDHDR ; Freeze header text while processing order actions
|
|---|
| 190 | I $D(VALM("TM")) S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC
|
|---|
| 191 | Q
|
|---|
| 192 | LOCKERR ;
|
|---|
| 193 | 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
|
|---|
| 194 | Q
|
|---|
| 195 | FLAG(DFN,PSJORD) ;Flag order through CPRS entry point.
|
|---|
| 196 | N ORIFN,NODE0
|
|---|
| 197 | 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))
|
|---|
| 198 | S ORIFN=$P(NODE0,"^",21)
|
|---|
| 199 | D EN1^ORCFLAG(ORIFN)
|
|---|
| 200 | D PAUSE^VALM1
|
|---|
| 201 | Q
|
|---|
| 202 | ;
|
|---|
| 203 | COMPLEX(DFN,ON) ;
|
|---|
| 204 | N NDP2,COM
|
|---|
| 205 | 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 | S COM=$P(NDP2,"^",8) I COM Q 1
|
|---|
| 207 | Q 0
|
|---|
