- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPS1.m
r613 r623 1 ORCDPS1 ;SLC/MKB-Pharmacy dialog utilities ; 08 May 2002 2:12 PM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,117,141,149,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J) 5 ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J) 6 ; 7 EN(TYPE) ; -- entry action for Meds dialogs 8 S ORINPT=$$INPT^ORCD,ORCAT=$G(TYPE) 9 I 'ORINPT,ORCAT="I" D IMOLOC^ORIMO(.ORINPT,+ORL,+ORVP) S:ORINPT<0 ORINPT=0 ;allow inpt meds at this location? 10 I ORCAT="" D 11 . I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT),$L($P($G(OR0),U,12)) S ORCAT=$P(OR0,U,12) Q ;use value from order, via ORCACT4 12 . S ORCAT=$S(ORINPT:"I",1:"O") 13 S ORDG=+$O(^ORD(100.98,"B",$S(ORCAT="I":"UD RX",1:"O RX"),0)) 14 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 15 I $G(ORENEW)!$G(OREWRITE)!$G(OREDIT)!$G(ORXFER) D Q:$G(ORQUIT) 16 . I 'ORINPT,ORCAT="I" D Q:$G(ORQUIT) 17 .. N OI S OI=+$O(^OR(100,+$G(ORIFN),.1,"B",0)) Q:OI<1 18 .. I '$O(^ORD(101.43,OI,9,"B","IVM RX",0)) S ORQUIT=1 W $C(7),!!,"This order may not be placed at this location!" Q 19 . K ORDIALOG($$PTR("START DATE/TIME"),1) 20 . K ORDIALOG($$PTR("NOW"),1) Q:ORCAT'="O" 21 . N WP S WP=$$PTR("WORD PROCESSING 1") 22 . I '$G(ORXFER),'$$DRAFT^ORWDX2($G(ORIFN)) K ORDIALOG(WP,1),^TMP("ORWORD",$J,WP) 23 . I $G(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J) 24 I ORINPT,ORCAT="O" W $C(7),!!,"NOTE: This will create an outpatient prescription for an inpatient!",! 25 Q 26 ; 27 EN1 ; -- setup Meds dialog for quick order editor using ORDG 28 N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3) 29 I $P(DG," ")="O"!(DG="SPLY") S ORINPT=0,ORCAT="O" 30 E S ORINPT=1,ORCAT="I" 31 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 32 Q 33 ; 34 ENOI ; -- setup OI prompt 35 N D S D=$G(ORDIALOG(PROMPT,"D")) 36 S:D="S.RX" ORDIALOG(PROMPT,"D")=$S(ORCAT="I":"S.UD RX",1:"S.O RX") 37 I ORCAT="I",'ORINPT,D="S.UD RX" D ;limit to IV meds for outpt's 38 . S ORDIALOG(PROMPT,"D")="S.IVM RX" ;ORDG=+$O(^ORD(100.98,"B","O RX",0)) 39 . S ORDIALOG(PROMPT,"?")="Enter the IV medication you wish to order for this patient." 40 Q 41 ; 42 DEA ; -- ck DEA# of ordering provider if SchedII drug 43 Q:$G(ORTYPE)="Z" N DEAFLG,PSOI 44 S PSOI=+$P($G(^ORD(101.43,+$G(Y),0)),U,2) Q:PSOI'>0 45 S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,ORCAT) Q:DEAFLG'>0 ;ok 46 I $G(ORNP),'$L($P($G(^VA(200,+ORNP,"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" K DONE Q 47 I DEAFLG=1 W $C(7),!,"This order will require a wet signature!" 48 Q 49 ; 50 CHANGED(X) ; -- Kill dependent values when prompt X changes 51 N PROMPTS,NAME,PTR,P,I 52 S PROMPTS=X I X="OI" D 53 . S PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DURATION^AND/THEN^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS^DAYS SUPPLY^QUANTITY^REFILLS^SERVICE CONNECTED" 54 . K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY 55 . K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 56 I X="DS" S PROMPTS="QUANTITY^REFILLS" K OREFILLS 57 F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D 58 . S PTR=$$PTR(NAME) Q:'PTR 59 . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I) 60 . K ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$J,PTR) 61 Q 62 ; 63 ORDITM(OI) ; -- Check OI, get dependent info 64 Q:OI'>0 ;quit - no value 65 N ORPS,ORPSOI S ORPS=$G(^ORD(101.43,+OI,"PS")),ORPSOI=+$P($G(^(0)),U,2) 66 S ORIV=$S($P(ORPS,U)=2:1,1:0) 67 I $G(ORCAT)="O",'$P(ORPS,U,2) W $C(7),!,"This drug may not be used in an outpatient order." S ORQUIT=1 D WAIT Q 68 I $G(ORCAT)="I" D Q:$G(ORQUIT) 69 . I $G(ORINPT),'$P(ORPS,U) W $C(7),!,"This drug may not be used in an inpatient order." S ORQUIT=1 D WAIT Q 70 . I '$G(ORINPT),'ORIV W $C(7),!,"This drug may not be ordered for an outpatient." S ORQUIT=1 D WAIT Q 71 I $G(ORTYPE)="Q" D I $G(ORQUIT) D WAIT Q 72 . N DEAFLG S DEAFLG=$$OIDEA^PSSUTLA1(ORPSOI,ORCAT) Q:DEAFLG'>0 ;ok 73 . I $G(ORNP),'$L($P($G(^VA(200,+ORNP,"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S ORQUIT=1 Q 74 . I DEAFLG=1 W $C(7),!,"This order will require a wet signature!" 75 OI1 ; -ck NF status 76 I $P(ORPS,U,6),'$G(ORENEW) D ;alternative 77 . W !!,"*** This medication is not in the formulary! ***" 78 . N PSX,CNT,ORX,DIR,X,Y,DTOUT,DUOUT 79 . D EN1^PSSUTIL1(.ORPSOI,ORCAT) I '$O(ORPSOI(0)) D Q 80 .. W !," There are no formulary alternatives entered for this item." 81 .. W !," Please consult with your pharmacy before ordering it." 82 . S PSX=0,CNT=0 F S PSX=$O(ORPSOI(PSX)) Q:PSX'>0 D 83 .. S ORX=+$O(^ORD(101.43,"ID",PSX_";99PSP",0)) Q:ORX'>0 84 .. S CNT=CNT+1,ORPSOI("OI",CNT)=ORX_U_PSX 85 .. S DIR("A",CNT)=$J(CNT,3)_" "_$P($G(^ORD(101.43,ORX,0)),U) 86 . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select alternative (or <return> to continue): " 87 . S DIR("?")="The medication selected is not in the formulary; you may select one of the above listed alternatives instead, or press <return> to continue processing this order." 88 . Q:CNT'>0 W !," Formulary alternatives:" D ^DIR 89 . I Y'>0 S:$D(DTOUT)!$D(DUOUT) ORQUIT=1 Q 90 . D:OI'=+ORPSOI("OI",+Y) CHANGED("OI") ;reset parameters if different 91 . S OI=+ORPSOI("OI",+Y),ORDIALOG(PROMPT,INST)=OI,OROI=OI 92 . S ORPSOI=+$P(ORPSOI("OI",+Y),U,2) 93 OI2 ; -get routes, doses [also called from NF^ORCDPS] 94 D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(ORPSOI,$G(ORCAT)) ;DBIA 2418 95 I '$D(ORDOSE) D 96 . D DOSE^PSSORUTL(.ORDOSE,ORPSOI,$S($G(ORCAT)="I":"U",1:"O"),+ORVP) 97 . K:$G(ORDOSE(1))=-1 ORDOSE 98 Q 99 ; 100 NFI(OI) ; -- Show NFI restrictions, if exist 101 N PSOI,I,J,LCNT,MAX,X,STOP 102 S PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2) 103 D EN^PSSDIN(PSOI,"") Q:'$D(^TMP("PSSDIN",$J,"OI",PSOI)) ;DBIA 3166 104 S I=0,LCNT=0,MAX=$S($G(IOBM)&$G(IOTM):IOBM-IOTM+1,1:24) W ! 105 F S I=$O(^TMP("PSSDIN",$J,"OI",PSOI,I)) Q:I'>0 D 106 . S J=0 F S J=$O(^TMP("PSSDIN",$J,"OI",PSOI,I,J)) Q:J'>0 S X=$G(^(J)) D Q:$G(STOP) 107 .. S LCNT=LCNT+1 I LCNT'<MAX S:'$$CONT STOP=1 Q:$G(STOP) S LCNT=1 108 .. W !,X 109 W ! K ^TMP("PSSDIN",$J,"OI",PSOI) 110 Q 111 ; 112 CONT() ; -- Cont or stop? 113 N X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT S DIR(0)="EA" 114 S DIR("A")="Press <return> to continue or ^ to stop ..." 115 D ^DIR S:$D(DUOUT)!$D(DTOUT) Y="" 116 Q +Y 117 ; 118 WAIT ; -- Wait for user 119 N X W !,"Press <return> to continue ..." R X:DTIME 120 Q 121 ; 122 ROUTES ; -- Get med routes 123 Q:$G(ORDIALOG(PROMPT,"LIST")) N I,X,CNT S (I,CNT)=0 124 F S I=$O(^TMP("PSJMR",$J,I)) Q:I'>0 S X=^(I),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=$P(X,U,3)_U_$P(X,U,1,2),ORDIALOG(PROMPT,"LIST","B",$P(X,U))=$P(X,U,3) 125 S:$G(CNT) ORDIALOG(PROMPT,"LIST")=CNT 126 S:$G(ORTYPE)'="Z" REQD=$S(ORCAT="I":1,$P($G(^ORD(101.43,+$G(OROI),"PS")),U,5):0,1:1) 127 Q 128 ; 129 DEFRTE ; -- Get default route 130 N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST 131 I INST1=INST S Y=+$P($G(^TMP("PSJMR",$J,1)),U,3) K:Y'>0 Y Q 132 S Y=+$G(ORDIALOG(PROMPT,INST1)) K:Y'>0 Y S:$G(Y) EDITONLY=1 133 Q 134 ; 135 CKSCH ; -- validate schedule [Called from P-S Action] 136 N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET) K ORSD 137 D EN^PSSGS0(.ORX,$G(ORCAT)) 138 I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q ;ok 139 W $C(7),!,"Enter a standard schedule for administering this medication" 140 K DONE I $G(ORCAT)="I" W ".",! Q 141 W " or one of your own,",!,"up to 20 characters.",! 142 Q 143 ; 144 DEFCONJ ; -- Set default conjuction for previous instance [P-S Action] 145 N LAST,DUR,CONJ 146 S LAST=$O(ORDIALOG(PROMPT,ORI),-1) Q:LAST'>0 ;first instance 147 S CONJ=$$PTR("AND/THEN") Q:$L($G(ORDIALOG(CONJ,LAST))) 148 S DUR=$G(ORDIALOG($$PTR("DURATION"),LAST)) 149 S ORDIALOG(CONJ,LAST)=$S(+DUR'>0:"A",1:"T") 150 Q 151 ; 152 ENCONJ ; -- Get allowable values, if req'd for INST 153 N P S P=$$PTR("INSTRUCTIONS") 154 S REQD=$S($O(ORDIALOG(P,INST)):1,1:0) 155 S ORDIALOG(PROMPT,"A")="And/then"_$S(ORCAT="O":"/except: ",1:": ") 156 S $P(ORDIALOG(PROMPT,0),U,2)="A:AND;T:THEN;"_$S(ORCAT="O":"X:EXCEPT;",1:"") 157 Q 158 ; 159 DSUP ; -- Get max/default days supply 160 N ORX,Y 161 S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG) 162 D DSUP^PSOSIGDS(.ORX) S Y=+$G(ORX("DAYS SUPPLY")) S:Y'>0 Y=90 163 ;S $P(ORDIALOG(PROMPT,0),U,2)="1:"_Y ;max allowed 164 I '$G(ORDIALOG(PROMPT,1)),$G(ORTYPE)'="Z" S ORDIALOG(PROMPT,1)=Y 165 Q 166 ; 167 QTY() ; -- Return default quantity [Expects ORDSUP] 168 N INSTR,DOSE,DUR,SCH,I,ORX,X,Y 169 S Y="" I $G(ORDSUP)'>0!'$G(ORDRUG) G QTYQ ;need days supply, disp drug 170 S INSTR=$$PTR("INSTRUCTIONS") 171 S DOSE=$$PTR("DOSE"),CONJ=$$PTR("AND/THEN") 172 S DUR=$$PTR("DURATION"),SCH=$$PTR("SCHEDULE") 173 S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D Q:'$D(ORX) 174 . S X=$P($G(ORDIALOG(DOSE,I)),"&",3) I X'>0 K ORX Q 175 . S ORX("DOSE ORDERED",I)=X,ORX("SCHEDULE",I)=$G(ORDIALOG(SCH,I)) 176 . S X=$G(ORDIALOG(DUR,I)),ORX("DURATION",I)=$$HL7DUR^ORMBLDPS 177 . S ORX("CONJUNCTION",I)=$G(ORDIALOG(CONJ,I)) 178 G:'$D(ORX) QTYQ ;no doses 179 S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG) 180 S ORX("DAYS SUPPLY")=+$G(ORDSUP) 181 D QTYX^PSOSIG(.ORX) S Y=$G(ORX("QTY")) 182 QTYQ Q Y 183 ; 184 MAXREFS ; -- Get max refills allowed [Entry Action] 185 Q:$G(ORCAT)'="O" N ORX,X 186 S ORX("ITEM")=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2) 187 S ORX("DRUG")=+$G(ORDRUG),ORX("PATIENT")=+$G(ORVP) 188 I $G(OREVENT),$$TYPE^OREVNTX(OREVENT)="D" S ORX("DISCHARGE")=1 189 S ORX("DAYS SUPPLY")=$G(ORDSUP) D MAX^PSOSIGDS(.ORX) 190 S OREFILLS=$G(ORX("MAX")),X=$G(ORDIALOG(PROMPT,INST)) 191 I OREFILLS'>0 S ORDIALOG(PROMPT,INST)=0 W !,"No refills allowed." Q 192 S $P(ORDIALOG(PROMPT,0),U,2)="0:"_OREFILLS 193 S ORDIALOG(PROMPT,"A")="Refills (0-"_OREFILLS_"): " 194 I X,X>OREFILLS S ORDIALOG(PROMPT,INST)=OREFILLS 195 Q 196 ; 197 ASKSC() ; -- Return 1 or 0, if SC prompt should be asked 198 I $$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0 199 ;I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay 200 Q 1 201 ; 202 PTR(X) ; -- Return ptr to prompt OR GTX X 203 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0)) 204 ; 205 EXIT ; -- exit action for Meds 206 S:$G(ORXNP) ORNP=ORXNP 207 K ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX 208 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 209 Q 1 ORCDPS1 ;SLC/MKB-Pharmacy dialog utilities ; 08 May 2002 2:12 PM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,117,141,149,195,215**;Dec 17, 1997 3 ; 4 ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J) 5 ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J) 6 ; 7 EN(TYPE) ; -- entry action for Meds dialogs 8 S ORINPT=$$INPT^ORCD,ORCAT=$G(TYPE) 9 I 'ORINPT,ORCAT="I" D IMOLOC^ORIMO(.ORINPT,+ORL,+ORVP) S:ORINPT<0 ORINPT=0 ;allow inpt meds at this location? 10 I ORCAT="" D 11 . I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT),$L($P($G(OR0),U,12)) S ORCAT=$P(OR0,U,12) Q ;use value from order, via ORCACT4 12 . S ORCAT=$S(ORINPT:"I",1:"O") 13 S ORDG=+$O(^ORD(100.98,"B",$S(ORCAT="I":"UD RX",1:"O RX"),0)) 14 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 15 I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT)!$G(ORXFER) D Q:$G(ORQUIT) 16 . I 'ORINPT,ORCAT="I" D Q:$G(ORQUIT) 17 .. N OI S OI=+$O(^OR(100,+$G(ORIFN),.1,"B",0)) Q:OI<1 18 .. I '$O(^ORD(101.43,OI,9,"B","IVM RX",0)) S ORQUIT=1 W $C(7),!!,"This order may not be placed at this location!" Q 19 . K ORDIALOG($$PTR("START DATE/TIME"),1) 20 . K ORDIALOG($$PTR("NOW"),1) Q:ORCAT'="O" 21 . I $G(OREDIT)!$G(OREWRITE) N PI S PI=$$PTR("PATIENT INSTRUCTIONS") K ORDIALOG(PI,1),^TMP("ORWORD",$J,PI) 22 . I $D(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J) 23 I ORINPT,ORCAT="O" W $C(7),!!,"NOTE: This will create an outpatient prescription for an inpatient!",! 24 Q 25 ; 26 EN1 ; -- setup Meds dialog for quick order editor using ORDG 27 N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3) 28 I $P(DG," ")="O"!(DG="SPLY") S ORINPT=0,ORCAT="O" 29 E S ORINPT=1,ORCAT="I" 30 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 31 Q 32 ; 33 ENOI ; -- setup OI prompt 34 N D S D=$G(ORDIALOG(PROMPT,"D")) 35 S:D="S.RX" ORDIALOG(PROMPT,"D")=$S(ORCAT="I":"S.UD RX",1:"S.O RX") 36 I ORCAT="I",'ORINPT,D="S.UD RX" D ;limit to IV meds for outpt's 37 . S ORDIALOG(PROMPT,"D")="S.IVM RX" ;ORDG=+$O(^ORD(100.98,"B","O RX",0)) 38 . S ORDIALOG(PROMPT,"?")="Enter the IV medication you wish to order for this patient." 39 Q 40 ; 41 DEA ; -- ck DEA# of ordering provider if SchedII drug 42 Q:$G(ORTYPE)="Z" N DEAFLG,PSOI 43 S PSOI=+$P($G(^ORD(101.43,+$G(Y),0)),U,2) Q:PSOI'>0 44 S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,ORCAT) Q:DEAFLG'>0 ;ok 45 I $G(ORNP),'$L($P($G(^VA(200,+ORNP,"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" K DONE Q 46 I DEAFLG=1 W $C(7),!,"This order will require a wet signature!" 47 Q 48 ; 49 CHANGED(X) ; -- Kill dependent values when prompt X changes 50 N PROMPTS,NAME,PTR,P,I 51 S PROMPTS=X I X="OI" D 52 . S PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DURATION^AND/THEN^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS^DAYS SUPPLY^QUANTITY^REFILLS^SERVICE CONNECTED" 53 . K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY 54 . K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 55 I X="DS" S PROMPTS="QUANTITY^REFILLS" K OREFILLS 56 F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D 57 . S PTR=$$PTR(NAME) Q:'PTR 58 . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I) 59 . K ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$J,PTR) 60 Q 61 ; 62 ORDITM(OI) ; -- Check OI, get dependent info 63 Q:OI'>0 ;quit - no value 64 N ORPS,ORPSOI S ORPS=$G(^ORD(101.43,+OI,"PS")),ORPSOI=+$P($G(^(0)),U,2) 65 S ORIV=$S($P(ORPS,U)=2:1,1:0) 66 I $G(ORCAT)="O",'$P(ORPS,U,2) W $C(7),!,"This drug may not be used in an outpatient order." S ORQUIT=1 D WAIT Q 67 I $G(ORCAT)="I" D Q:$G(ORQUIT) 68 . I $G(ORINPT),'$P(ORPS,U) W $C(7),!,"This drug may not be used in an inpatient order." S ORQUIT=1 D WAIT Q 69 . I '$G(ORINPT),'ORIV W $C(7),!,"This drug may not be ordered for an outpatient." S ORQUIT=1 D WAIT Q 70 I $G(ORTYPE)="Q" D I $G(ORQUIT) D WAIT Q 71 . N DEAFLG S DEAFLG=$$OIDEA^PSSUTLA1(ORPSOI,ORCAT) Q:DEAFLG'>0 ;ok 72 . I $G(ORNP),'$L($P($G(^VA(200,+ORNP,"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S ORQUIT=1 Q 73 . I DEAFLG=1 W $C(7),!,"This order will require a wet signature!" 74 OI1 ; -ck NF status 75 I $P(ORPS,U,6),'$G(ORENEW) D ;alternative 76 . W !!,"*** This medication is not in the formulary! ***" 77 . N PSX,CNT,ORX,DIR,X,Y,DTOUT,DUOUT 78 . D EN1^PSSUTIL1(.ORPSOI,ORCAT) I '$O(ORPSOI(0)) D Q 79 .. W !," There are no formulary alternatives entered for this item." 80 .. W !," Please consult with your pharmacy before ordering it." 81 . S PSX=0,CNT=0 F S PSX=$O(ORPSOI(PSX)) Q:PSX'>0 D 82 .. S ORX=+$O(^ORD(101.43,"ID",PSX_";99PSP",0)) Q:ORX'>0 83 .. S CNT=CNT+1,ORPSOI("OI",CNT)=ORX_U_PSX 84 .. S DIR("A",CNT)=$J(CNT,3)_" "_$P($G(^ORD(101.43,ORX,0)),U) 85 . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select alternative (or <return> to continue): " 86 . S DIR("?")="The medication selected is not in the formulary; you may select one of the above listed alternatives instead, or press <return> to continue processing this order." 87 . Q:CNT'>0 W !," Formulary alternatives:" D ^DIR 88 . I Y'>0 S:$D(DTOUT)!$D(DUOUT) ORQUIT=1 Q 89 . D:OI'=+ORPSOI("OI",+Y) CHANGED("OI") ;reset parameters if different 90 . S OI=+ORPSOI("OI",+Y),ORDIALOG(PROMPT,INST)=OI,OROI=OI 91 . S ORPSOI=+$P(ORPSOI("OI",+Y),U,2) 92 OI2 ; -get routes, doses [also called from NF^ORCDPS] 93 D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(ORPSOI,$G(ORCAT)) ;DBIA 2418 94 I '$D(ORDOSE) D 95 . D DOSE^PSSORUTL(.ORDOSE,ORPSOI,$S($G(ORCAT)="I":"U",1:"O"),+ORVP) 96 . K:$G(ORDOSE(1))=-1 ORDOSE 97 Q 98 ; 99 NFI(OI) ; -- Show NFI restrictions, if exist 100 N PSOI,I,J,LCNT,MAX,X,STOP 101 S PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2) 102 D EN^PSSDIN(PSOI,"") Q:'$D(^TMP("PSSDIN",$J,"OI",PSOI)) ;DBIA 3166 103 S I=0,LCNT=0,MAX=$S($G(IOBM)&$G(IOTM):IOBM-IOTM+1,1:24) W ! 104 F S I=$O(^TMP("PSSDIN",$J,"OI",PSOI,I)) Q:I'>0 D 105 . S J=0 F S J=$O(^TMP("PSSDIN",$J,"OI",PSOI,I,J)) Q:J'>0 S X=$G(^(J)) D Q:$G(STOP) 106 .. S LCNT=LCNT+1 I LCNT'<MAX S:'$$CONT STOP=1 Q:$G(STOP) S LCNT=1 107 .. W !,X 108 W ! K ^TMP("PSSDIN",$J,"OI",PSOI) 109 Q 110 ; 111 CONT() ; -- Cont or stop? 112 N X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT S DIR(0)="EA" 113 S DIR("A")="Press <return> to continue or ^ to stop ..." 114 D ^DIR S:$D(DUOUT)!$D(DTOUT) Y="" 115 Q +Y 116 ; 117 WAIT ; -- Wait for user 118 N X W !,"Press <return> to continue ..." R X:DTIME 119 Q 120 ; 121 ROUTES ; -- Get med routes 122 Q:$G(ORDIALOG(PROMPT,"LIST")) N I,X,CNT S (I,CNT)=0 123 F S I=$O(^TMP("PSJMR",$J,I)) Q:I'>0 S X=^(I),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=$P(X,U,3)_U_$P(X,U,1,2),ORDIALOG(PROMPT,"LIST","B",$P(X,U))=$P(X,U,3) 124 S:$G(CNT) ORDIALOG(PROMPT,"LIST")=CNT 125 S:$G(ORTYPE)'="Z" REQD=$S(ORCAT="I":1,$P($G(^ORD(101.43,+$G(OROI),"PS")),U,5):0,1:1) 126 Q 127 ; 128 DEFRTE ; -- Get default route 129 N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST 130 I INST1=INST S Y=+$P($G(^TMP("PSJMR",$J,1)),U,3) K:Y'>0 Y Q 131 S Y=+$G(ORDIALOG(PROMPT,INST1)) K:Y'>0 Y S:$G(Y) EDITONLY=1 132 Q 133 ; 134 CKSCH ; -- validate schedule [Called from P-S Action] 135 N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET) K ORSD 136 D EN^PSSGS0(.ORX,$G(ORCAT)) 137 I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q ;ok 138 W $C(7),!,"Enter a standard administration schedule" 139 K DONE I $G(ORCAT)="I" W ".",! Q 140 W " or one of your own,",!,"up to 70 characters and no more than 2 spaces.",! 141 Q 142 ; 143 DEFCONJ ; -- Set default conjuction for previous instance [P-S Action] 144 N LAST,DUR,CONJ 145 S LAST=$O(ORDIALOG(PROMPT,ORI),-1) Q:LAST'>0 ;first instance 146 S CONJ=$$PTR("AND/THEN") Q:$L($G(ORDIALOG(CONJ,LAST))) 147 S DUR=$G(ORDIALOG($$PTR("DURATION"),LAST)) 148 S ORDIALOG(CONJ,LAST)=$S(+DUR'>0:"A",1:"T") 149 Q 150 ; 151 ENCONJ ; -- Get allowable values, if req'd for INST 152 N P S P=$$PTR("INSTRUCTIONS") 153 S REQD=$S($O(ORDIALOG(P,INST)):1,1:0) 154 S ORDIALOG(PROMPT,"A")="And/then"_$S(ORCAT="O":"/except: ",1:": ") 155 S $P(ORDIALOG(PROMPT,0),U,2)="A:AND;T:THEN;"_$S(ORCAT="O":"X:EXCEPT;",1:"") 156 Q 157 ; 158 DSUP ; -- Get max/default days supply 159 N ORX,Y 160 S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG) 161 D DSUP^PSOSIGDS(.ORX) S Y=+$G(ORX("DAYS SUPPLY")) S:Y'>0 Y=90 162 ;S $P(ORDIALOG(PROMPT,0),U,2)="1:"_Y ;max allowed 163 I '$G(ORDIALOG(PROMPT,1)),$G(ORTYPE)'="Z" S ORDIALOG(PROMPT,1)=Y 164 Q 165 ; 166 QTY() ; -- Return default quantity [Expects ORDSUP] 167 N INSTR,DOSE,DUR,SCH,I,ORX,X,Y 168 S Y="" I $G(ORDSUP)'>0!'$G(ORDRUG) G QTYQ ;need days supply, disp drug 169 S INSTR=$$PTR("INSTRUCTIONS") 170 S DOSE=$$PTR("DOSE"),CONJ=$$PTR("AND/THEN") 171 S DUR=$$PTR("DURATION"),SCH=$$PTR("SCHEDULE") 172 S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D Q:'$D(ORX) 173 . S X=$P($G(ORDIALOG(DOSE,I)),"&",3) I X'>0 K ORX Q 174 . S ORX("DOSE ORDERED",I)=X,ORX("SCHEDULE",I)=$G(ORDIALOG(SCH,I)) 175 . S X=$G(ORDIALOG(DUR,I)),ORX("DURATION",I)=$$HL7DUR^ORMBLDPS 176 . S ORX("CONJUNCTION",I)=$G(ORDIALOG(CONJ,I)) 177 G:'$D(ORX) QTYQ ;no doses 178 S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG) 179 S ORX("DAYS SUPPLY")=+$G(ORDSUP) 180 D QTYX^PSOSIG(.ORX) S Y=$G(ORX("QTY")) 181 QTYQ Q Y 182 ; 183 MAXREFS ; -- Get max refills allowed [Entry Action] 184 Q:$G(ORCAT)'="O" N ORX,X 185 S ORX("ITEM")=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2) 186 S ORX("DRUG")=+$G(ORDRUG),ORX("PATIENT")=+$G(ORVP) 187 I $G(OREVENT),$$TYPE^OREVNTX(OREVENT)="D" S ORX("DISCHARGE")=1 188 S ORX("DAYS SUPPLY")=$G(ORDSUP) D MAX^PSOSIGDS(.ORX) 189 S OREFILLS=$G(ORX("MAX")),X=$G(ORDIALOG(PROMPT,INST)) 190 I OREFILLS'>0 S ORDIALOG(PROMPT,INST)=0 W !,"No refills allowed." Q 191 S $P(ORDIALOG(PROMPT,0),U,2)="0:"_OREFILLS 192 S ORDIALOG(PROMPT,"A")="Refills (0-"_OREFILLS_"): " 193 I X,X>OREFILLS S ORDIALOG(PROMPT,INST)=OREFILLS 194 Q 195 ; 196 ASKSC() ; -- Return 1 or 0, if SC prompt should be asked 197 I $$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0 198 ;I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay 199 Q 1 200 ; 201 PTR(X) ; -- Return ptr to prompt OR GTX X 202 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0)) 203 ; 204 EXIT ; -- exit action for Meds 205 S:$G(ORXNP) ORNP=ORXNP 206 K ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX 207 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J) 208 Q
Note:
See TracChangeset
for help on using the changeset viewer.
