- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPS2.m
r613 r623 1 ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;12/14/2006 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131,243**;Dec 17, 1997;Build 242 3 ; 4 COMPLEX() ; -- Single or complex? 5 N X,Y,DIR,DUOUT,DTOUT,COMPLX 6 S COMPLX=$S($O(ORDIALOG(PROMPT,"?"),-1)>1:1,$L($G(ORDIALOG($$PTR("DURATION"),1))):1,1:0) 7 I $G(ORTYPE)="Q",$O(ORDIALOG(PROMPT,0)),FIRST Q COMPLX 8 I $D(ORENEW)!$D(OREWRITE)!$D(ORXFER)!COMPLX Q COMPLX 9 I $D(OREDIT) Q:$D(ORCOMPLX)!COMPLX COMPLX G CP1 ;Q if complex or 'first, else ask 10 I 'FIRST S Y=$S($D(ORCOMPLX):ORCOMPLX,1:COMPLX) Q Y 11 CP1 S DIR(0)="YA",DIR("A")="Complex dose? ",DIR("B")="NO" 12 S DIR("?")="Enter YES if you wish to enter multiple sets of dosage instructions, a tapering dose, or to limit the duration of a single dose." 13 D ^DIR S:$D(DTOUT) Y="^" 14 Q Y 15 ; 16 DOSES ; -- Available common doses 17 ;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80") 18 S ORDIALOG(PROMPT,"A")="Dose"_$S(ORCAT="I"&$G(ORIV):" or Rate: ",1:": ") 19 S $P(ORDIALOG(PROMPT,"?"),",",2)=$S($G(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.") 20 I FIRST,'$O(ORDIALOG(PROMPT,0)),$G(ORXFER) D SHOWSIG^ORCMED 21 S ORCOMPLX=$$COMPLEX,MULT=+ORCOMPLX I ORCOMPLX="^" S ORQUIT=1 Q 22 Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$D(ORDOSE) 23 D1 ; -- Entry from ORCMED,NF^ORCDPS to build list 24 N I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT 25 S (I,CNT)=0,CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ 26 F S I=$O(ORDOSE(I)) Q:I'>0 D 27 . S X=ORDOSE(I),DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD) 28 . ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost 29 . ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills? 30 . S DOSE=$P(X,U,5),UD=$P(X,U,3),COST=$P(X,U,7) Q:'$L(DOSE) 31 . I '$P(X,U) S DOSE=DOSE_CONJ_" "_$S($L($P(DRUG,U,5)):$P(DRUG,U,5)_$P(DRUG,U,6),1:$P(DRUG,U)) 32 . ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4) 33 . S TEXT=DOSE_$S($L(COST):" $"_COST,1:"")_$S($P(DRUG,U,3):" (non-formulary)",1:"") 34 . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT 35 . S ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE 36 . S ORDIALOG(PROMPT,"LIST","D",DOSE)=DD ;default DispDrug 37 . S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I),U,1,6)_U_$P(DRUG,U,5,6) 38 . S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D ;xref alt forms of dose 39 .. S DD=+$P(ORDOSE(I,J),U,6),DRUG=$G(ORDOSE("DD",DD)) 40 .. S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I,J),U,1,6)_U_$P(DRUG,U,5,6) 41 S:CNT ORDIALOG(PROMPT,"LIST")=CNT 42 Q 43 ; 44 CHDOSE ; -- Kill dependent values if inst ORI of dose changes 45 N X,PROMPTS,P,NAME,DOSE,DD S X=$G(ORDIALOG(PROMPT,ORI)) 46 S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase 47 I X,X'?1.N.E1.A.E K DONE W $C(7),!,"Enter the amount of this drug that the patient is to receive as a dose,",!,"NOT as the number of units per dose." Q 48 I $L(X)>60,'$D(ORDIALOG(PROMPT,"LIST","B",X)) K DONE W $C(7),!,"Instructions may not be longer than 60 characters." Q 49 I $G(ORESET)'=X D ;kill dependent values if new/changed dose 50 . S PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS" 51 . F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) K ORDIALOG($$PTR(NAME),ORI) 52 . K ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1) 53 . K ^TMP("ORWORD",$J,$$PTR("SIG")) 54 S DOSE=$$PTR("DOSE") I $L(X),'$L($G(ORDIALOG(DOSE,ORI))) D ;set ID 55 . S DD=+$G(ORDIALOG(PROMPT,"LIST","D",X)) 56 . S:DD ORDIALOG(DOSE,ORI)=$TR($G(ORDOSE("DD",DD,X)),"^","&") 57 S DD=+$P($G(ORDIALOG(DOSE,ORI)),"&",6) 58 I DD,$P($G(ORDOSE("DD",DD)),U,3) D NF^ORCDPS(DD) ;look for FormAlt 59 Q 60 ; 61 EXDOSE ; -- Exit Action 62 Q:'$O(ORDIALOG(PROMPT,0)) N DRUG,MISC,QUIT,LAST 63 S ORDRUG=$$DISPDRUG^ORCDPS,DRUG=$G(ORDOSE("DD",+ORDRUG)) 64 I ORDRUG D I $G(QUIT) S ORQUIT=1 Q 65 . ;I $P(DRUG,U,10),'$L($P($G(^VA(200,+$G(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 QUIT=1 Q 66 . ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!" 67 . S ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG 68 . D:$G(ORCAT)="O" RESETID^ORCDPS 69 . N STR,MED S STR=$P(DRUG,U,5)_$P(DRUG,U,6) 70 . I STR'>0 S:'$G(ORDOSE(1)) ORDIALOG($$PTR("DRUG NAME"),1)=$P(DRUG,U) Q 71 . S MED=$P($G(^ORD(101.43,+$G(OROI),0)),U) 72 . I MED'[STR,ORCAT="O"!'$G(ORDOSE(1)) S ORDIALOG($$PTR("STRENGTH"),1)=STR 73 I +ORDRUG'>0,ORCAT="O" W $C(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!" 74 EXD1 ; -- Kill dangling conjunction, [re]build Sig, get Qty info 75 S LAST=$O(ORDIALOG(PROMPT,"?"),-1) K ORDIALOG($$PTR("AND/THEN"),LAST) 76 D ADMIN^ORCDPS3 D:$G(ORTYPE)'="Z" SIG ;[re]build Sig/Text 77 I ORDRUG,ORCAT="O" D ;set Qty info 78 . S:$L($P(DRUG,U,4)) ORQTYUNT=$P(DRUG,U,4) 79 . S MISC=$$ENDCM^PSJORUTL(+ORDRUG),ORQTY=$P(MISC,U,4) 80 . W:$L($P(MISC,U,2)) !!,$P(MISC,U,2),! 81 Q 82 ; 83 SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT 84 ; Return text in ^TMP("ORWORD",$J,SIG,INST) 85 ; [also called from PSJ^ORCSEND1 to build child orders] 86 ; 87 N ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE 88 S ORT=$$PTR("ROUTE"),ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION") 89 S ORID=$$PTR("DOSE"),ORCNJ=$$PTR("AND/THEN"),ORS=$$PTR("SIG") 90 S ORMISC=$G(ORDOSE("MISC")),ORPREP=$P(ORMISC,U,2) 91 S ORX=$S(ORCAT="I":"",ORCAT="O"&(+$G(ISIMO)=1):"",$L($P(ORMISC,U)):$P(ORMISC,U)_" ",1:"") ;"TAKE " 92 S (CNT,ORI)=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 D 93 . S DOSE=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(DOSE) 94 . S ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ 95 . S CNT=CNT+1,ORSIG(CNT,0)=ORX,ORX="" 96 Q:CNT'>0 S ORSIG(0)="^^"_CNT_U_CNT_U_DT_U 97 K ^TMP("ORWORD",$J,ORS,1) M ^(1)=ORSIG S ORDIALOG(PROMPT,"FORMAT")="@" 98 S ORDIALOG(ORS,1)=$NA(^TMP("ORWORD",$J,ORS,1)) 99 Q 100 ; 101 PTR(X) ; -- Ptr to prompt OR GTX X 102 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0)) 103 ; 104 DOSE() ; -- Dosage 105 N X0,Y S X0=$G(ORDIALOG(ORID,ORI)) ;ID string 106 S Y=DOSE I ORDRUG,$L(X0) D ;use local dose if common DispDrug 107 . S:$L($P(X0,"&",5)) Y=$P(X0,"&",5) ;unless Outpt w/total dose 108 . I ORCAT="O",X0 S Y=$$WORD($P(X0,"&",3))_" "_$P(X0,"&",4) ;u/d 109 Q Y 110 ; 111 WORD(X) ; -- Words for number X 112 N X1,X2,Y S X1=$P(+X,"."),X2=$P(+X,".",2) 113 S Y="" I X1 S Y=$S(X1=1:"ONE",X1=2:"TWO",X1=3:"THREE",X1=4:"FOUR",X1=5:"FIVE",X1=6:"SIX",X1=7:"SEVEN",X1=8:"EIGHT",X1=9:"NINE",X1=10:"TEN",1:X1) 114 I X2 S Y=Y_$S($L(Y):" AND ",1:"")_$S(X2=5:"ONE-HALF",X2=33!(X2=34):"ONE-THIRD",X2=25:"ONE-FOURTH",X2=66!(X2=67):"TWO-THIRDS",X2=75:"THREE-FOURTHS",1:"."_X2) 115 Q Y 116 ; 117 RTE() ; -- Expansion of route 118 N X,X0,Y S X=+$G(ORDIALOG(ORT,ORI)) Q:X'>0 "" 119 K ^TMP($J,"ORCDPS2 RTE") 120 D ALL^PSS51P2(+X,,,,"ORCDPS2 RTE") 121 ;S X0=$G(^PS(51.2,+X,0)),Y="" 122 I ORCAT="I"!(+$G(ISIMO)=1) S Y=" "_$S($L(^TMP($J,"ORCDPS2 RTE",+X,1)):^TMP($J,"ORCDPS2 RTE",+X,1),1:^TMP($J,"ORCDPS2 RTE",+X,.01)) 123 ;I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U)) 124 I ORCAT="O",'+$G(ISIMO) S Y=" "_$S($L(ORPREP):ORPREP_" ",1:"")_$S($L(^TMP($J,"ORCDPS2 RTE",+X,4)):^TMP($J,"ORCDPS2 RTE",+X,4),1:^TMP($J,"ORCDPS2 RTE",+X,.01)) 125 Q Y 126 ; 127 SCH() ; -- [outpatient] expansion of schedule 128 N X,Y S X=$G(ORDIALOG(ORSCH,ORI)) 129 I $L(X),ORCAT="O",'+$G(ISIMO) D SCH^PSSUTIL1(.X) 130 S Y=$S($L(X):" "_X,1:"") 131 Q Y 132 ; 133 DUR() ; -- Duration 134 N X,Y S X=$G(ORDIALOG(ORDUR,ORI)),Y="" 135 I X S Y=" FOR "_$$UP^XLFSTR(X)_$S(+X=X:" DAYS",1:"") 136 Q Y 137 ; 138 CONJ() ; -- Conjunction 139 N X,Y S X=$G(ORDIALOG(ORCNJ,ORI)) 140 S:$L(X)>1 X=$E(X) S:X="E" S="X" 141 S Y=$S(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"") 142 Q Y 143 ; 144 DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders 145 ; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE] 146 ; 147 N ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,X,PROMPT 148 S ORTYPE=$S($G(ORCAT)="I":"U",1:"O") 149 D DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP) 150 S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ 151 S ORDRUG=+$G(ORDIALOG(DRUG,1)),DRUG0=$G(ORDOSE("DD",ORDRUG)) 152 S STRG=$P(DRUG0,U,5)_$P(DRUG0,U,6) 153 I '$G(ORDOSE(1)) S ORI=0 F S ORI=$O(ORDIALOG(INSTR,ORI)) Q:ORI'>0 D 154 . S LDOSE=$G(ORDIALOG(INSTR,ORI)),X=$G(ORDIALOG(DOSE,ORI)) Q:'$L(X) 155 . S:'X ORDIALOG(INSTR,ORI)=LDOSE_CONJ_" "_$S(STRG:STRG,1:$P(DRUG0,U)) 156 ; -build Sig/Text if not defined 157 I '$D(ORDIALOG(+$$PTR("SIG"),1)) S PROMPT=INSTR D SIG 158 Q 159 ; 160 PI ; -- Include Pt Instructions w/Sig in Outpt order? 161 N X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT 162 I $G(ORCAT)'="O" D CLEARWP Q ;!'$O(ORDOSE("PI",0)) 163 Q:$G(ORENEW) S I=0,ORMAX=57 164 I $G(OREDIT)!$G(OREWRITE),$O(^TMP("ORWORD",$J,PROMPT,INST,0)) K ORDOSE("PI") S I=0 F S I=$O(^TMP("ORWORD",$J,PROMPT,INST,I)) Q:I<1 S ORDOSE("PI",I)=$G(^(I,0)) 165 I '$O(ORDOSE("PI",0)) D CLEARWP Q 166 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S X=ORDOSE("PI",I) D TXT^ORCHTAB 167 S DIR(0)="YA",DIR("A")="Include Patient Instructions in Sig? " 168 S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")=$S($D(^TMP("ORWORD",$J,PROMPT)):"YES",1:"NO") 169 W ! S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"Patient Instructions: ",1:" ")_ORTX(I) 170 D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q 171 I Y D Q ;save text 172 . K ^TMP("ORWORD",$J,PROMPT,INST) S CNT=0 173 . S I=0 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S ^TMP("ORWORD",$J,PROMPT,INST,I,0)=ORDOSE("PI",I),CNT=CNT+1 174 . S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U 175 . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")" 176 I Y'>0 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST) 177 Q 178 ; 179 CLEARWP ; -- Clear INST of wp field PROMPT 180 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST) 181 Q 1 ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;07:24 AM 5 Apr 2001 [12/31/01 6:35pm] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131**;Dec 17, 1997 3 ; 4 COMPLEX() ; -- Single or complex dose? 5 N X,Y,DIR,DUOUT,DTOUT,COMPLX 6 S COMPLX=$S($O(ORDIALOG(PROMPT,"?"),-1)>1:1,$L($G(ORDIALOG($$PTR("DURATION"),1))):1,1:0) 7 I $G(ORTYPE)="Q",$O(ORDIALOG(PROMPT,0)),FIRST Q COMPLX 8 I $D(ORENEW)!$D(OREWRITE)!$D(ORXFER)!COMPLX Q COMPLX 9 I $D(OREDIT) Q:$D(ORCOMPLX)!COMPLX COMPLX G CP1 ;Q if complex or 'first, else ask 10 I 'FIRST S Y=$S($D(ORCOMPLX):ORCOMPLX,1:COMPLX) Q Y 11 CP1 S DIR(0)="YA",DIR("A")="Complex dose? ",DIR("B")="NO" 12 S DIR("?")="Enter YES if you wish to enter multiple sets of dosage instructions, a tapering dose, or to limit the duration of a single dose." 13 D ^DIR S:$D(DTOUT) Y="^" 14 Q Y 15 ; 16 DOSES ; -- Get available common doses 17 ;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80") 18 S ORDIALOG(PROMPT,"A")="Dose"_$S(ORCAT="I"&$G(ORIV):" or Rate: ",1:": ") 19 S $P(ORDIALOG(PROMPT,"?"),",",2)=$S($G(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.") 20 I FIRST,'$O(ORDIALOG(PROMPT,0)),$G(ORXFER) D SHOWSIG^ORCMED 21 S ORCOMPLX=$$COMPLEX,MULT=+ORCOMPLX I ORCOMPLX="^" S ORQUIT=1 Q 22 Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$D(ORDOSE) 23 D1 ; -- enter here from ORCMED,NF^ORCDPS to build list 24 N I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT 25 S (I,CNT)=0,CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ 26 F S I=$O(ORDOSE(I)) Q:I'>0 D 27 . S X=ORDOSE(I),DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD) 28 . ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost 29 . ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills? 30 . S DOSE=$P(X,U,5),UD=$P(X,U,3),COST=$P(X,U,7) Q:'$L(DOSE) 31 . I '$P(X,U) S DOSE=DOSE_CONJ_" "_$S($L($P(DRUG,U,5)):$P(DRUG,U,5)_$P(DRUG,U,6),1:$P(DRUG,U)) 32 . ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4) 33 . S TEXT=DOSE_$S($L(COST):" $"_COST,1:"")_$S($P(DRUG,U,3):" (non-formulary)",1:"") 34 . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT 35 . S ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE 36 . S ORDIALOG(PROMPT,"LIST","D",DOSE)=DD ;default DispDrug 37 . S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I),U,1,6)_U_$P(DRUG,U,5,6) 38 . S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D ;xref alt forms of dose 39 .. S DD=+$P(ORDOSE(I,J),U,6),DRUG=$G(ORDOSE("DD",DD)) 40 .. S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I,J),U,1,6)_U_$P(DRUG,U,5,6) 41 S:CNT ORDIALOG(PROMPT,"LIST")=CNT 42 Q 43 ; 44 CHDOSE ; -- kill dependent values if inst ORI of dose changes 45 N X,PROMPTS,P,NAME,DOSE,DD S X=$G(ORDIALOG(PROMPT,ORI)) 46 S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase 47 I X,X'?1.N.E1.A.E K DONE W $C(7),!,"Enter the amount of this drug that the patient is to receive as a dose,",!,"NOT as the number of units per dose." Q 48 I $L(X)>60,'$D(ORDIALOG(PROMPT,"LIST","B",X)) K DONE W $C(7),!,"Instructions may not be longer than 60 characters." Q 49 I $G(ORESET)'=X D ;kill dependent values if new/changed dose 50 . S PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS" 51 . F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) K ORDIALOG($$PTR(NAME),ORI) 52 . K ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1) 53 . K ^TMP("ORWORD",$J,$$PTR("SIG")) 54 S DOSE=$$PTR("DOSE") I $L(X),'$L($G(ORDIALOG(DOSE,ORI))) D ;set ID 55 . S DD=+$G(ORDIALOG(PROMPT,"LIST","D",X)) 56 . S:DD ORDIALOG(DOSE,ORI)=$TR($G(ORDOSE("DD",DD,X)),"^","&") 57 S DD=+$P($G(ORDIALOG(DOSE,ORI)),"&",6) 58 I DD,$P($G(ORDOSE("DD",DD)),U,3) D NF^ORCDPS(DD) ;look for FormAlt 59 Q 60 ; 61 EXDOSE ; -- Dose Exit Action 62 Q:'$O(ORDIALOG(PROMPT,0)) N DRUG,MISC,QUIT,LAST 63 S ORDRUG=$$DISPDRUG^ORCDPS,DRUG=$G(ORDOSE("DD",+ORDRUG)) 64 I ORDRUG D I $G(QUIT) S ORQUIT=1 Q 65 . ;I $P(DRUG,U,10),'$L($P($G(^VA(200,+$G(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 QUIT=1 Q 66 . ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!" 67 . S ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG 68 . D:$G(ORCAT)="O" RESETID^ORCDPS 69 . N STR,MED S STR=$P(DRUG,U,5)_$P(DRUG,U,6) 70 . I STR'>0 S:'$G(ORDOSE(1)) ORDIALOG($$PTR("DRUG NAME"),1)=$P(DRUG,U) Q 71 . S MED=$P($G(^ORD(101.43,+$G(OROI),0)),U) 72 . I MED'[STR,ORCAT="O"!'$G(ORDOSE(1)) S ORDIALOG($$PTR("STRENGTH"),1)=STR 73 I +ORDRUG'>0,ORCAT="O" W $C(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!" 74 EXD1 ; -kill dangling conjunction, [re]build Sig, get Qty info 75 S LAST=$O(ORDIALOG(PROMPT,"?"),-1) K ORDIALOG($$PTR("AND/THEN"),LAST) 76 D ADMIN^ORCDPS3 D:$G(ORTYPE)'="Z" SIG ;[re]build Sig/Text 77 I ORDRUG,ORCAT="O" D ;set Qty info 78 . S:$L($P(DRUG,U,4)) ORQTYUNT=$P(DRUG,U,4) 79 . S MISC=$$ENDCM^PSJORUTL(+ORDRUG),ORQTY=$P(MISC,U,4) 80 . W:$L($P(MISC,U,2)) !!,$P(MISC,U,2),! 81 Q 82 ; 83 SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT 84 ; Return text in ^TMP("ORWORD",$J,SIG,INST) 85 ; [also called from PSJ^ORCSEND1 to build child orders] 86 ; 87 N ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE 88 S ORT=$$PTR("ROUTE"),ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION") 89 S ORID=$$PTR("DOSE"),ORCNJ=$$PTR("AND/THEN"),ORS=$$PTR("SIG") 90 S ORMISC=$G(ORDOSE("MISC")),ORPREP=$P(ORMISC,U,2) 91 S ORX=$S(ORCAT="I":"",$L($P(ORMISC,U)):$P(ORMISC,U)_" ",1:"") ;"TAKE " 92 S (CNT,ORI)=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 D 93 . S DOSE=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(DOSE) 94 . S ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ 95 . S CNT=CNT+1,ORSIG(CNT,0)=ORX,ORX="" 96 Q:CNT'>0 S ORSIG(0)="^^"_CNT_U_CNT_U_DT_U 97 K ^TMP("ORWORD",$J,ORS,1) M ^(1)=ORSIG S ORDIALOG(PROMPT,"FORMAT")="@" 98 S ORDIALOG(ORS,1)=$NA(^TMP("ORWORD",$J,ORS,1)) 99 Q 100 ; 101 PTR(X) ; -- Return ptr to prompt OR GTX X 102 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0)) 103 ; 104 DOSE() ; -- Return dosage 105 N X0,Y S X0=$G(ORDIALOG(ORID,ORI)) ;ID string 106 S Y=DOSE I ORDRUG,$L(X0) D ;use local dose if common DispDrug 107 . S:$L($P(X0,"&",5)) Y=$P(X0,"&",5) ;unless Outpt w/total dose 108 . I ORCAT="O",X0 S Y=$$WORD($P(X0,"&",3))_" "_$P(X0,"&",4) ;u/d 109 Q Y 110 ; 111 WORD(X) ; -- Return words for number X 112 N X1,X2,Y S X1=$P(+X,"."),X2=$P(+X,".",2) 113 S Y="" I X1 S Y=$S(X1=1:"ONE",X1=2:"TWO",X1=3:"THREE",X1=4:"FOUR",X1=5:"FIVE",X1=6:"SIX",X1=7:"SEVEN",X1=8:"EIGHT",X1=9:"NINE",X1=10:"TEN",1:X1) 114 I X2 S Y=Y_$S($L(Y):" AND ",1:"")_$S(X2=5:"ONE-HALF",X2=33!(X2=34):"ONE-THIRD",X2=25:"ONE-FOURTH",X2=66!(X2=67):"TWO-THIRDS",X2=75:"THREE-FOURTHS",1:"."_X2) 115 Q Y 116 ; 117 RTE() ; -- Return expansion of route 118 N X,X0,Y S X=+$G(ORDIALOG(ORT,ORI)) Q:X'>0 "" 119 S X0=$G(^PS(51.2,+X,0)),Y="" 120 I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U)) 121 I ORCAT="O" S Y=" "_$S($L(ORPREP):ORPREP_" ",1:"")_$S($L($P(X0,U,2)):$P(X0,U,2),1:$P(X0,U)) 122 Q Y 123 ; 124 SCH() ; -- Return [outpatient] expansion of schedule 125 N X,Y S X=$G(ORDIALOG(ORSCH,ORI)) 126 I $L(X),ORCAT="O" D SCH^PSSUTIL1(.X) 127 S Y=$S($L(X):" "_X,1:"") 128 Q Y 129 ; 130 DUR() ; -- Return duration 131 N X,Y S X=$G(ORDIALOG(ORDUR,ORI)),Y="" 132 I X S Y=" FOR "_$$UP^XLFSTR(X)_$S(+X=X:" DAYS",1:"") 133 Q Y 134 ; 135 CONJ() ; -- Return conjuction 136 N X,Y S X=$G(ORDIALOG(ORCNJ,ORI)) 137 S:$L(X)>1 X=$E(X) S:X="E" S="X" 138 S Y=$S(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"") 139 Q Y 140 ; 141 DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders 142 ; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE] 143 ; 144 N ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,X,PROMPT 145 S ORTYPE=$S($G(ORCAT)="I":"U",1:"O") 146 D DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP) 147 S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ 148 S ORDRUG=+$G(ORDIALOG(DRUG,1)),DRUG0=$G(ORDOSE("DD",ORDRUG)) 149 S STRG=$P(DRUG0,U,5)_$P(DRUG0,U,6) 150 I '$G(ORDOSE(1)) S ORI=0 F S ORI=$O(ORDIALOG(INSTR,ORI)) Q:ORI'>0 D 151 . S LDOSE=$G(ORDIALOG(INSTR,ORI)),X=$G(ORDIALOG(DOSE,ORI)) Q:'$L(X) 152 . S:'X ORDIALOG(INSTR,ORI)=LDOSE_CONJ_" "_$S(STRG:STRG,1:$P(DRUG0,U)) 153 ; -build Sig/Text if not defined 154 I '$D(ORDIALOG(+$$PTR("SIG"),1)) S PROMPT=INSTR D SIG 155 Q 156 ; 157 PI ; -- Include Patient Instructions w/Sig in Outpt order? 158 N X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT 159 I $G(ORCAT)'="O" D CLEARWP Q ;!'$O(ORDOSE("PI",0)) 160 Q:$G(ORENEW) S I=0,ORMAX=57 161 I $G(OREDIT)!$G(OREWRITE),$O(^TMP("ORWORD",$J,PROMPT,INST,0)) K ORDOSE("PI") S I=0 F S I=$O(^TMP("ORWORD",$J,PROMPT,INST,I)) Q:I<1 S ORDOSE("PI",I)=$G(^(I,0)) 162 I '$O(ORDOSE("PI",0)) D CLEARWP Q 163 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S X=ORDOSE("PI",I) D TXT^ORCHTAB 164 S DIR(0)="YA",DIR("A")="Include Patient Instructions in Sig? " 165 S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")="YES" 166 W ! S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"Patient Instructions: ",1:" ")_ORTX(I) 167 D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q 168 I Y D Q ;save text 169 . K ^TMP("ORWORD",$J,PROMPT,INST) S CNT=0 170 . S I=0 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S ^TMP("ORWORD",$J,PROMPT,INST,I,0)=ORDOSE("PI",I),CNT=CNT+1 171 . S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U 172 . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")" 173 I Y'>0 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST) 174 Q 175 ; 176 CLEARWP ; -- Clear INST of wp field PROMPT 177 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST) 178 Q
Note:
See TracChangeset
for help on using the changeset viewer.
