- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGSICHK.m
r613 r623 1 PSGSICHK ;BIR/CML3-CHECKS SPECIAL INSTRUCTIONS ;17 Aug 98 / 8:33 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**3,9,26,29,44,49,59,110,139,146,160,175,201,185**;16 DEC 97;Build 6 3 ; 4 ; Reference to ^PS(50.605 is supported by DBIA 696. 5 ; Reference to EN^PSOORDRG is supported by DBIA 2190. 6 ; Reference to ^PSI(58.1 is supported by DBIA 2284. 7 ; Reference to ^PSDRUG( is supported by DBIA 2192. 8 ; Reference to ^PSD(58.8 is supported by DBIA 2283. 9 ; Reference to ^PS(55 is supported by DBIA 2191. 10 ; Reference to ^PS(51.2 is supported by DBIA 2178. 11 ; Reference to ^PS(51 is supported by DBIA 2176. 12 ; Reference to ^ORRDI1 is supported by DBIA 4659. 13 ; Reference to ^XTMP("ORRDI" is supported by DBIA 4660. 14 ; Reference to GETDATA^GMRAOR supported by DBIA 4847. 15 ; Reference to ^TMP("GMRAOC" supported by DBIA 4848. 16 ; 17 START ; 18 I $S(X'?.ANP:1,X["^":1,1:$L(X)>180) K X Q 19 S Y="" F Y(1)=1:1:$L(X," ") S Y(2)=$P(X," ",Y(1)) I Y(2)]"" D CHK Q:'$D(X) 20 I $D(X),Y]"",X'=$E(Y,1,$L(Y)-1) D EN^DDIOL("EXPANDS TO: ") W Y F Y(1)=1:1 S Y(2)=$P(Y," ",Y(1)) Q:Y(2)="" D:$L(Y(2))+$X>78 EN^DDIOL(Y(2)_" ") 21 Q 22 ; 23 CHK ; 24 I $L(Y(2))<31,$D(^PS(51,+$O(^PS(51,"B",Y(2),0)),0)),$P(^(0),"^",2)]"",$P(^(0),"^",4) S Y(2)=$P(^(0),"^",2) 25 I $L(Y)+$L(Y(2))>180 K X Q 26 S Y=Y_Y(2)_" " Q 27 ; 28 ENSET(X) ; expands the SPECIAL INSTRUCTIONS field contained in X into Y 29 N X1,X2,Y S Y="" 30 ;BHW;PSJ*5*185;Modified Logic below to NOT strip spaces and allow existing logic to flow. 31 ; ;Removed code I X2]"" Before Set of Y and created argumentless DO structure. 32 F X1=1:1:$L(X," ") S X2=$P(X," ",X1) D 33 . I X2']"" S Y=Y_" " Q ;if multiple spaces in text and were $P'ing through text, X2 will="" so just add space and continue 34 . S Y=Y_$S($L(X2)>30:X2,'$D(^PS(51,+$O(^PS(51,"B",X2,0)),0)):X2,$P(^(0),"^",2)]""&$P(^(0),"^",4):$P(^(0),"^",2),1:X2)_" " 35 . Q 36 ;BHW;Modified stripping of spaces at end of string 37 F X1=$L(Y):-1:0 Q:$E(Y,X1,X1)'=" " S Y=$E(Y,1,X1-1) 38 Q Y 39 ; 40 END ; used by DRUG (55.06,101 & 53.1,101) x-refs to warn user if patient is receiving or about to receive the drug just ordered 41 Q:$D(PSJHLSKP) 42 N Z,ZZ,STATUSNP I $G(PSJPWD)&($P($G(PSJSYSU),";")=3)&($G(PSGDRG)) I ($D(^PSI(58.1,"D",PSGDRG,PSJPWD)))!($D(^PSD(58.8,"D",PSGDRG,PSJPWD))) D EN^DDIOL(" *** A WARD STOCK ITEM ***") 43 D NOW^%DTC 44 N PSJDCHK F Z=%:0 S Z=$O(^PS(55,+PSGP,5,"AUS",Z)) Q:'Z!$D(DUOUT) F ZZ=0:0 S ZZ=$O(^PS(55,+PSGP,5,"AUS",Z,ZZ)) Q:'ZZ!$D(DUOUT) I +$G(^PS(55,+PSGP,5,ZZ,.2))=PSGX D PDWCHK(+PSGP,ZZ_"U") S PSJDCHK=1 45 F STATUSNP="N","P" F Z=0:0 S Z=$O(^PS(53.1,"AS",STATUSNP,+PSGP,Z)) Q:'Z!$D(DUOUT) I +$G(^PS(53.1,+Z,.2))=PSGX D PDWCHK(+PSGP,Z_"P") S PSJDCHK=1 46 I $D(PSJDCHK) N DIR D 47 .S DIR(0)="Y",DIR("A")="Do you wish to continue entering this order",DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order," 48 .S DIR("?")="or ""Y"" to continue with the order entry process." D ^DIR S:'Y Y=-1,X="^" 49 K Z,ZZ 50 Q 51 ; 52 ENDDC(PSGP,PSJDD) ; Perform Duplicate Drug, Duplicate Class, 53 ; Drug-Drug interaction check, Drug-Allergy interaction check. 54 N PSJLINE,Z,ZZ,PSJFST 55 S (PSJLINE,PSJFST)=0 56 I $G(PSJPWD)&($P($G(PSJSYSU),";")=3)&($G(PSJDD)) I ($D(^PSI(58.1,"D",PSJDD,PSJPWD)))!($D(^PSD(58.8,"D",PSJDD,PSJPWD))) W !?25,"*** A WARD STOCK ITEM ***" 57 D EN^PSOORDRG(PSGP,PSJDD) K PSJPDRG N INTERVEN,PSJIREQ,PSJRXREQ S Y=1,(PSJIREQ,PSJRXREQ,INTERVEN,X)="" S DFN=PSGP 58 I $T(HAVEHDR^ORRDI1)]"",$$HAVEHDR^ORRDI1,'$D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D 59 . I $P($G(^XTMP("ORRDI","PSOO",PSGP,0)),"^",3)<0 W !,"Remote data not available - Only local order checks processed." D PAUSE^PSJLMUT1 60 I $D(^TMP($J,"DD")) D ORDCHK^PSJLMUT1(PSGP,"DD",4) 61 I $D(^TMP($J,"DC")) D ORDCHK^PSJLMUT1(PSGP,"DC",6) 62 IVSOL ;*** Start order check for IV solution at this point. 63 I '$D(PSJFST) N PSJFST S PSJFST=0 64 I $D(^TMP($J,"DI")) S INTERVEN=1 D ORDCHK^PSJLMUT1(PSGP,"DI",8) 65 ;*** Allergy/adverse reaction check. 66 N PTR,X 67 S PTR=$P($G(^PSDRUG(PSJDD,"ND")),U)_"."_$P($G(^PSDRUG(PSJDD,"ND")),U,3) 68 K ^TMP("PSJDAI",$J) S PSJACK=$$ORCHK^GMRAOR(DFN,"DR",PTR) D:$G(PSJACK)=1 69 .S ^TMP("PSJDAI",$J,0)=1 70 .S I=0 F S I=$O(GMRAING(I)) Q:'I S ^TMP("PSJDAI",$J,I,0)=GMRAING(I) 71 I $D(^TMP("PSJDAI",$J)) S PSJPDRG=1 D 72 .W $C(7),!!,"A Drug-Allergy Reaction exists for this medication!",!! 73 .W !?7,"Drug: "_$P($G(^PSDRUG(PSJDD,0)),"^") I $O(^TMP("PSJDAI",$J)) W !,"Ingredients: " D 74 ..S I=0 F S I=$O(^TMP("PSJDAI",$J,I)) Q:'I W:$X+$L($G(^(I,0)))+2>IOM !?19 W:I=1 $G(^TMP("PSJDAI",$J,I,0)) W:I>1 ", ",$G(^TMP("PSJDAI",$J,I,0)) 75 .W !! 76 K PSJACK,GMRAING,I,^TMP($J) 77 D ALGCLASS 78 CONT ; Ask user if they wish to continue in spite of an order check. 79 Q:'$D(PSJPDRG) N DIR S DIR(0)="Y",DIR("A")="Do you wish to continue entering this order",DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order," 80 S DIR("?")="or ""Y"" to continue with the order entry process.",DIR("B")="NO" D ^DIR I 'Y S PSGORQF=1,X="^",COMQUIT=1 Q 81 I 'INTERVEN!($P(PSJSYSU,";")'=3) Q 82 NEW PSJY 83 W:PSJIREQ !!,"This is a CRITICAL interaction, you must enter an intervention log to continue" 84 S DIR(0)="Y",DIR("A")="Do you wish to log an intervention",DIR("?",1)="Enter ""N"" if you do not wish to log an intervention,",DIR("?")="or ""Y"" to log an intervention." D ^DIR S PSJY=Y D:Y ^PSJRXI 85 I 'PSJY,PSJIREQ S PSGORQF=1,COMQUIT=1 86 Q 87 ; 88 ENDL ; used by PSGTRAIN DRUG LOOK-UP option 89 D ENCV^PSGSETU Q:$D(XQUIT) 90 F S DIC="^PSDRUG(",DIC(0)="AEIMOQZ",DIC("A")="Select DRUG: " W ! D ^DIC K DIC Q:+Y'>0 D SF 91 D ENKV^PSGSETU K N5,ND,Q,Y Q 92 ; 93 SF ; 94 S Y=+Y,ND=$G(^PSDRUG(Y,0)),PSGID=+$G(^("I")) I PSGID W !!,"THIS DRUG IS INACTIVE AS OF ",$E($$ENDTC^PSGMI(PSGID),1,8) 95 W !!,$S($P(ND,"^",9):"NON-",1:""),"FORMULARY ITEM" W:$P(ND,"^",10)]"" !,$P(ND,"^",10) 96 S ND=$P($G(^PSDRUG(Y,2)),"^",3)["U" W !,$P("NOT^","^",ND+1)," A UNIT DOSE DRUG" W ! S ND=$G(^(8)),N5=$G(^(8.5)) W !?2,"DAY (nD) or DOSE (nL) LIMIT: " I ND W $P(ND,"^") 97 W !?10,"UNIT DOSE MED ROUTE: " I $P(ND,"^",2) W $S($D(^PS(51.2,$P(ND,"^",2),0)):$P(^(0),"^"),1:$P(ND,"^",2)) 98 ; NAKED REF below refers to ^PS(51.2, on line above. 99 W !?6,"UNIT DOSE SCHEDULE TYPE: " I $P(ND,"^",3)]"" W $P($P(";"_$P(^(0),"^",3),";"_$P(ND,"^",3)_":",2),";") 100 W !?11,"UNIT DOSE SCHEDULE: " I $P(ND,"^",4)]"" W $P(ND,"^",4) 101 W !,"CORRESPONDING OUTPATIENT DRUG: " I $P(ND,"^",5) W $S('$D(^PSDRUG(+$P(ND,"^",5),0)):$P(ND,"^",5),$P(^(0),"^")]"":$P(^(0),"^"),1:$P(ND,"^",5)) 102 W !?17,"ATC MNEMONIC: " I $P(N5,"^",2)]"" W $P(N5,"^",2) 103 W !?17,"ATC CANISTER: " F Q=0:0 S Q=$O(^PSDRUG(Y,212,Q)) Q:'Q S ND=$G(^(Q,0)) I ND,$P(ND,"^",2) W ?31,$S('$D(^PS(57.5,+ND,0)):+ND_";PS(57.5,",$P(^(0),"^")]"":$P(^(0),"^"),1:+ND_";PS(57.5,"),?56,$P(ND,"^",2),! 104 Q 105 ; 106 OCHK ; Add drugs in current order to ^TMP("ORDERS" and call order checker. 107 ; Set PSJOCHK=1 so OP order check doesn't Kill array. 108 ; 109 K ^TMP($J,"ORDERS") 110 N PSJOCHK S PSJOCHK=1 111 PDWCHK(DFN,ON) ; Print Dup Drug order. 112 N ND,ND0,ND2,X 113 W:'$D(PSJDCHK) $C(7),$C(7),!!,"WARNING! THIS PATIENT HAS THE FOLLOWING ORDER(S) FOR THIS MEDICATION:",!! 114 S ND=$$DRUGNAME^PSJLMUTL(DFN,ON) 115 S F=$S(ON["P":"^PS(53.1,",1:"^PS(55,"_DFN_",5,"),ND0=$G(@(F_+ON_",0)")),ND2=$G(^(2)),X=$P(ND,U,2),X=$S(X=.2:$P($G(^(.2)),U,2),1:$G(^(.3))) 116 W ?10,$P(ND,U),!,?13,"Give: ",X," ",$$ENMRN^PSGMI(+$P(ND0,U,3))," ",$P(ND2,U),!! 117 Q 118 ALGCLASS ; checks any Drug allergies or reactions to see if 119 ; the new drug is the same class 120 ; this call can be removed by commenting out the call on IVSOL+16 121 N PSJLIST,CT,CLS,CLCHK,CNT,PSJL,LIST,DCCNT,PSCLASS,LEN 122 S PSCLASS=$P($G(^PSDRUG(PSJDD,0)),"^",2),LEN=4 I $E(PSCLASS,1,4)="CN10" S LEN=5 ;look at 5 chars if ANALGESICS 123 I $T(GETDATA^GMRAOR)]"" G ALGC2 124 S GMRA="0^0^111" D EN1^GMRADPT 125 F PSJLIST=0:0 S PSJLIST=$O(GMRAL(PSJLIST)) Q:'PSJLIST D 126 .K PSJAGL D EN1^GMRAOR2(PSJLIST,"PSJAGL") 127 .; is the allergy/reaction drug class first four digits the same as the 128 .; the class for the drug being entered? 129 .S (CT,CLS)="",DCCNT=0 130 .I $D(PSJAGL("V")) D 131 ..F S DCCNT=$O(PSJAGL("V",DCCNT)) Q:'DCCNT S:$E($P($G(PSJAGL("V",DCCNT)),"^"),1,LEN)=$E(PSCLASS,1,LEN) (PSJPDRG,CLCHK)=1,CNT=$S('$D(CNT):1,1:CNT+1),LIST(CNT)=$P($G(PSJAGL),"^")_"^"_$P($G(PSJAGL("V",DCCNT)),"^",2) 132 D:$G(CLCHK) 133 .W !!,$C(7),"A Drug-Allergy Reaction exists for this medication and/or class!" 134 .F PSJL=0:0 S PSJL=$O(LIST(PSJL)) Q:'PSJL D 135 ..W !?6,"Drug: "_$P(LIST(PSJL),"^"),!,"Drug Class: "_$P(LIST(PSJL),"^",2),! 136 Q 137 ALGC2 ; 138 K GMRADRCL 139 D GETDATA^GMRAOR(DFN) Q:'$D(^TMP("GMRAOC",$J,"APC")) 140 N GMRACL,RET 141 S RET=0,GMRACL="" F S GMRACL=$O(^TMP("GMRAOC",$J,"APC",GMRACL)) Q:'$L(GMRACL) D 142 .N GMRANM,GMRALOC 143 .S GMRALOC=^TMP("GMRAOC",$J,"APC",GMRACL) 144 .S GMRANM=$P(^PS(50.605,+$O(^PS(50.605,"B",GMRACL,0)),0),U,2) 145 .S GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")" 146 .S RET=RET+1 147 Q:'RET K ^TMP("GMRAOC",$J) 148 S CLCHK="",CT="" F S CT=$O(GMRADRCL(CT)) Q:CT="" D 149 .I $E(PSCLASS,1,LEN)=$E(CT,1,LEN) S CLCHK=$G(CLCHK)+1,^TMP($J,"PSJDRCLS",CLCHK)=CT_" "_$P(GMRADRCL(CT),"^",2) 150 CLASSDSP ; 151 I '$D(^TMP($J,"PSJDRCLS")) Q 152 W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",! 153 W !,"Drug: "_$P($G(^PSDRUG(PSJDD,0)),"^") 154 S CT="" F S CT=$O(^TMP($J,"PSJDRCLS",CT)) Q:CT="" W !,"Drug Class: "_^TMP($J,"PSJDRCLS",CT) 155 K ^TMP($J,"PSJDRCLS") 156 S DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication," 157 S DIR("?")=" 'NO' if you DON'T want to enter a reaction for this medication," 158 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR 159 I Y D ^PSJRXI 160 I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q 161 Q 1 PSGSICHK ;BIR/CML3-CHECKS SPECIAL INSTRUCTIONS ;17 Aug 98 / 8:33 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**3,9,26,29,44,49,59,110,139,146,160,175**;16 DEC 97;Build 18 3 ; 4 ; Reference to EN^PSOORDRG is supported by DBIA 2190. 5 ; Reference to ^PSI(58.1 is supported by DBIA 2284. 6 ; Reference to ^PSDRUG( is supported by DBIA 2192. 7 ; Reference to ^PSD(58.8 is supported by DBIA 2283. 8 ; Reference to ^PS(55 is supported by DBIA 2191. 9 ; Reference to ^PS(51.2 is supported by DBIA 2178. 10 ; Reference to ^PS(51 is supported by DBIA 2176. 11 ; Reference to ^ORRDI1 is supported by DBIA 4659. 12 ; Reference to ^XTMP("ORRDI" is supported by DBIA 4660. 13 ; 14 START ; 15 I $S(X'?.ANP:1,X["^":1,1:$L(X)>180) K X Q 16 S Y="" F Y(1)=1:1:$L(X," ") S Y(2)=$P(X," ",Y(1)) I Y(2)]"" D CHK Q:'$D(X) 17 I $D(X),Y]"",X'=$E(Y,1,$L(Y)-1) D EN^DDIOL("EXPANDS TO: ") W Y F Y(1)=1:1 S Y(2)=$P(Y," ",Y(1)) Q:Y(2)="" D:$L(Y(2))+$X>78 EN^DDIOL(Y(2)_" ") 18 Q 19 ; 20 CHK ; 21 I $L(Y(2))<31,$D(^PS(51,+$O(^PS(51,"B",Y(2),0)),0)),$P(^(0),"^",2)]"",$P(^(0),"^",4) S Y(2)=$P(^(0),"^",2) 22 I $L(Y)+$L(Y(2))>180 K X Q 23 S Y=Y_Y(2)_" " Q 24 ; 25 ENSET(X) ; expands the SPECIAL INSTRUCTIONS field contained in X into Y 26 N X1,X2,Y S Y="" 27 F X1=1:1:$L(X," ") S X2=$P(X," ",X1) I X2]"" S Y=Y_$S($L(X2)>30:X2,'$D(^PS(51,+$O(^PS(51,"B",X2,0)),0)):X2,$P(^(0),"^",2)]""&$P(^(0),"^",4):$P(^(0),"^",2),1:X2)_" " 28 S Y=$E(Y,1,$L(Y)-1) Q Y 29 ; 30 END ; used by DRUG (55.06,101 & 53.1,101) x-refs to warn user if patient is receiving or about to receive the drug just ordered 31 Q:$D(PSJHLSKP) 32 N Z,ZZ,STATUSNP I $G(PSJPWD)&($P($G(PSJSYSU),";")=3)&($G(PSGDRG)) I ($D(^PSI(58.1,"D",PSGDRG,PSJPWD)))!($D(^PSD(58.8,"D",PSGDRG,PSJPWD))) D EN^DDIOL(" *** A WARD STOCK ITEM ***") 33 D NOW^%DTC 34 N PSJDCHK F Z=%:0 S Z=$O(^PS(55,+PSGP,5,"AUS",Z)) Q:'Z!$D(DUOUT) F ZZ=0:0 S ZZ=$O(^PS(55,+PSGP,5,"AUS",Z,ZZ)) Q:'ZZ!$D(DUOUT) I +$G(^PS(55,+PSGP,5,ZZ,.2))=PSGX D PDWCHK(+PSGP,ZZ_"U") S PSJDCHK=1 35 F STATUSNP="N","P" F Z=0:0 S Z=$O(^PS(53.1,"AS",STATUSNP,+PSGP,Z)) Q:'Z!$D(DUOUT) I +$G(^PS(53.1,+Z,.2))=PSGX D PDWCHK(+PSGP,Z_"P") S PSJDCHK=1 36 I $D(PSJDCHK) N DIR D 37 .S DIR(0)="Y",DIR("A")="Do you wish to continue entering this order",DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order," 38 .S DIR("?")="or ""Y"" to continue with the order entry process." D ^DIR S:'Y Y=-1,X="^" 39 K Z,ZZ 40 Q 41 ; 42 ENDDC(PSGP,PSJDD) ; Perform Duplicate Drug, Duplicate Class, 43 ; Drug-Drug interaction check, Drug-Allergy interaction check. 44 N PSJLINE,Z,ZZ,PSJFST 45 S (PSJLINE,PSJFST)=0 46 I $G(PSJPWD)&($P($G(PSJSYSU),";")=3)&($G(PSJDD)) I ($D(^PSI(58.1,"D",PSJDD,PSJPWD)))!($D(^PSD(58.8,"D",PSJDD,PSJPWD))) W !?25,"*** A WARD STOCK ITEM ***" 47 D EN^PSOORDRG(PSGP,PSJDD) K PSJPDRG N INTERVEN,PSJIREQ,PSJRXREQ S Y=1,(PSJIREQ,PSJRXREQ,INTERVEN,X)="" S DFN=PSGP 48 I $T(HAVEHDR^ORRDI1)]"",$$HAVEHDR^ORRDI1,'$D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D 49 . I $P($G(^XTMP("ORRDI","PSOO",PSGP,0)),"^",3)<0 W !,"Remote data not available - Only local order checks processed." D PAUSE^PSJLMUT1 50 K ^TMP($J,"DUPDRG") ;DEM - Duplicate Drug Check Ehancement. 51 I $D(^TMP($J,"DD")) D ORDCHK^PSJLMUT1(PSGP,"DD",4) 52 I $D(^TMP($J,"DC")) D ORDCHK^PSJLMUT1(PSGP,"DC",6) 53 IVSOL ;*** Start order check for IV solution at this point. 54 I '$D(PSJFST) N PSJFST S PSJFST=0 55 I $D(^TMP($J,"DI")) S INTERVEN=1 D ORDCHK^PSJLMUT1(PSGP,"DI",8) 56 D DUPDRG^PSJLMUT2(PSGP) K ^TMP($J,"DUPDRG") ;DEM - Duplicate Drug Check Ehancement. 57 ;*** Allergy/adverse reaction check. 58 N PTR,X 59 S PTR=$P($G(^PSDRUG(PSJDD,"ND")),U)_"."_$P($G(^PSDRUG(PSJDD,"ND")),U,3) 60 K ^TMP("PSJDAI",$J) S PSJACK=$$ORCHK^GMRAOR(DFN,"DR",PTR) D:$G(PSJACK)=1 61 .S ^TMP("PSJDAI",$J,0)=1 62 .S I=0 F S I=$O(GMRAING(I)) Q:'I S ^TMP("PSJDAI",$J,I,0)=GMRAING(I) 63 I $D(^TMP("PSJDAI",$J)) S PSJPDRG=1 D 64 .W $C(7),!!,"A Drug-Allergy Reaction exists for this medication!",!! 65 .W !?7,"Drug: "_$P($G(^PSDRUG(PSJDD,0)),"^") I $O(^TMP("PSJDAI",$J)) W !,"Ingredients: " D 66 ..S I=0 F S I=$O(^TMP("PSJDAI",$J,I)) Q:'I W:$X+$L($G(^(I,0)))+2>IOM !?19 W:I=1 $G(^TMP("PSJDAI",$J,I,0)) W:I>1 ", ",$G(^TMP("PSJDAI",$J,I,0)) 67 .W !! 68 K PSJACK,GMRAING,I,^TMP($J) 69 D ALGCLASS^PSGSICH1 70 CONT ; Ask user if they wish to continue in spite of an order check. 71 ;Variable PSJDDCON is the order continuation flag for Duplicate Drug Check Enhancement. 72 I $D(PSJDDCON("DD")),'PSJDDCON("DD") Q 73 I '$D(PSJDDCON("DD")) Q:'$D(PSJPDRG) N DIR D I 'Y S PSGORQF=1,X="^",COMQUIT=1 K PSJDDCON Q 74 . S DIR(0)="Y",DIR("A")=$S($G(PSJDDCON("DI")):"Do you wish to continue with the current order",1:"Do you wish to continue entering this order") 75 . S DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order,",DIR("?")="or ""Y"" to continue with the order entry process.",DIR("B")=$S($G(PSJDDCON("DI")):"YES",1:"NO") 76 . D ^DIR 77 . Q 78 ; 79 K PSJDDCON ;Order continuation flag for Duplicate Drug Check Enhancement. 80 I 'INTERVEN!($P(PSJSYSU,";")'=3) Q 81 N PSJY 82 W:PSJIREQ !!,"This is a CRITICAL interaction, you must enter an intervention log to continue" 83 S DIR(0)="Y",DIR("A")="Do you wish to log an intervention",DIR("?",1)="Enter ""N"" if you do not wish to log an intervention,",DIR("?")="or ""Y"" to log an intervention." D ^DIR S PSJY=Y D:Y ^PSJRXI 84 I 'PSJY,PSJIREQ S PSGORQF=1,COMQUIT=1 85 Q 86 ; 87 ENDL ; used by PSGTRAIN DRUG LOOK-UP option 88 D ENCV^PSGSETU Q:$D(XQUIT) 89 F S DIC="^PSDRUG(",DIC(0)="AEIMOQZ",DIC("A")="Select DRUG: " W ! D ^DIC K DIC Q:+Y'>0 D SF 90 D ENKV^PSGSETU K N5,ND,Q,Y 91 Q 92 ; 93 SF ; 94 N PSGID 95 S Y=+Y,ND=$G(^PSDRUG(Y,0)),PSGID=+$G(^("I")) I PSGID W !!,"THIS DRUG IS INACTIVE AS OF ",$E($$ENDTC^PSGMI(PSGID),1,8) 96 W !!,$S($P(ND,"^",9):"NON-",1:""),"FORMULARY ITEM" W:$P(ND,"^",10)]"" !,$P(ND,"^",10) 97 S ND=$P($G(^PSDRUG(Y,2)),"^",3)["U" W !,$P("NOT^","^",ND+1)," A UNIT DOSE DRUG" W ! S ND=$G(^(8)),N5=$G(^(8.5)) W !?2,"DAY (nD) or DOSE (nL) LIMIT: " I ND W $P(ND,"^") 98 W !?10,"UNIT DOSE MED ROUTE: " I $P(ND,"^",2) W $S($D(^PS(51.2,$P(ND,"^",2),0)):$P(^(0),"^"),1:$P(ND,"^",2)) 99 ; NAKED REF below refers to ^PS(51.2, on line above. 100 W !?6,"UNIT DOSE SCHEDULE TYPE: " I $P(ND,"^",3)]"" W $P($P(";"_$P(^(0),"^",3),";"_$P(ND,"^",3)_":",2),";") 101 W !?11,"UNIT DOSE SCHEDULE: " I $P(ND,"^",4)]"" W $P(ND,"^",4) 102 W !,"CORRESPONDING OUTPATIENT DRUG: " I $P(ND,"^",5) W $S('$D(^PSDRUG(+$P(ND,"^",5),0)):$P(ND,"^",5),$P(^(0),"^")]"":$P(^(0),"^"),1:$P(ND,"^",5)) 103 W !?17,"ATC MNEMONIC: " I $P(N5,"^",2)]"" W $P(N5,"^",2) 104 W !?17,"ATC CANISTER: " F Q=0:0 S Q=$O(^PSDRUG(Y,212,Q)) Q:'Q S ND=$G(^(Q,0)) I ND,$P(ND,"^",2) W ?31,$S('$D(^PS(57.5,+ND,0)):+ND_";PS(57.5,",$P(^(0),"^")]"":$P(^(0),"^"),1:+ND_";PS(57.5,"),?56,$P(ND,"^",2),! 105 Q 106 ; 107 OCHK ; Add drugs in current order to ^TMP("ORDERS" and call order checker. 108 ; Set PSJOCHK=1 so OP order check doesn't Kill array. 109 ; 110 K ^TMP($J,"ORDERS") 111 N PSJOCHK S PSJOCHK=1 112 PDWCHK(DFN,ON) ; Print Dup Drug order. 113 N ND,ND0,ND2,X 114 W:'$D(PSJDCHK) $C(7),$C(7),!!,"WARNING! THIS PATIENT HAS THE FOLLOWING ORDER(S) FOR THIS MEDICATION:",!! 115 S ND=$$DRUGNAME^PSJLMUTL(DFN,ON) 116 S F=$S(ON["P":"^PS(53.1,",1:"^PS(55,"_DFN_",5,"),ND0=$G(@(F_+ON_",0)")),ND2=$G(^(2)),X=$P(ND,U,2),X=$S(X=.2:$P($G(^(.2)),U,2),1:$G(^(.3))) 117 W ?10,$P(ND,U),!,?13,"Give: ",X," ",$$ENMRN^PSGMI(+$P(ND0,U,3))," ",$P(ND2,U),!! 118 Q
Note:
See TracChangeset
for help on using the changeset viewer.
