- 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/ORWDPS2.m
r613 r623 1 ORWDPS2 ; SLC/KCM/JLI - Pharmacy Calls for Windows Dialog;05/09/20072 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,116,125,131,132,148,141,195,215,258,243**;Dec 17, 1997;Build 242 3 4 OISLCT(LST,OI,PSTYPE,ORVP,NEEDPI,PKIACTIV) 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 PTINSTR 44 45 46 47 DOSAGE 48 49 50 51 52 53 DISPLST 54 55 56 57 58 59 60 ALLDOSE 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 BLDDOSE(X) 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 ROUTE 94 95 96 97 98 99 100 101 102 103 104 105 106 107 SCHED 108 109 110 GUIDE 111 112 113 114 115 116 OIMSG 117 118 119 ADMIN(REC,DFN,SCH,OI,LOC ,ADMIN); return administration time info120 121 122 123 I $L($G(^DPT(DFN,.1))) S REC=$$FIRST^ORCDPS3(DFN,LOC,OI,SCH,"",$G(ADMIN))124 125 REQST(VAL,DFN,SCH,OI,LOC,TXT) 126 127 128 129 130 131 132 133 DAY2QTY(VAL,DAY,UPD,SCH,DUR,PAT,DRG) 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 QTY2DAY(VAL,QTY,UPD,SCH,DUR,PAT,DRG) 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 MAXREF(VAL,PAT,DRG,SUP,OI,OUT) 168 169 170 171 172 173 174 175 176 177 178 179 SCHREQ(VAL,OI,RTE,DRG) 180 181 182 183 184 185 CHKPI(VAL,ODIFN) 186 187 188 189 190 191 192 193 194 CHKGRP(VAL,ORIFN) 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 QOGRP(VAL,QOIFN) 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 1 ORWDPS2 ; SLC/KCM/JLI - Pharmacy Calls for Windows Dialog 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,116,125,131,132,148,141,195,215,258**;Dec 17, 1997;Build 7 3 ; 4 OISLCT(LST,OI,PSTYPE,ORVP,NEEDPI,PKIACTIV) ; return for defaults for pharmacy orderable item 5 N ILST,ORDOSE,ORWPSOI,ORWDOSES,X1,X2 6 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J) 7 S ILST=0 8 S ORWPSOI=0 9 S:+OI ORWPSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) 10 D START^PSSJORDF(ORWPSOI,$S(PSTYPE="U":"I",1:"O")) ; dflt route, schedule, etc. 11 I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses 12 I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses NEW PKI CODE from pharmacy 13 D EN^PSSDIN(ORWPSOI) ; nfi text 14 S ILST=ILST+1,LST(ILST)="~Medication" 15 S ILST=ILST+1,LST(ILST)="d"_OI_U_$S(+OI:$P(^ORD(101.43,OI,0),U),1:"") 16 S ILST=ILST+1,LST(ILST)="~Verb" 17 S ILST=ILST+1,LST(ILST)="d"_$P($G(ORDOSE("MISC")),U) 18 S ILST=ILST+1,LST(ILST)="~Preposition" 19 S ILST=ILST+1,LST(ILST)="d"_$P($G(ORDOSE("MISC")),U,2) 20 I $D(NEEDPI),(NEEDPI="Y") S ILST=ILST+1,LST(ILST)="~PtInstr" D PTINSTR 21 ;S:NEEDPI="Y" ILST=ILST+1,LST(ILST)="~PtInstr" D PTINSTR 22 S ILST=ILST+1,LST(ILST)="~AllDoses" D ALLDOSE ; must do before DOSAGE 23 S ILST=ILST+1,LST(ILST)="~Dosage" D DOSAGE 24 S ILST=ILST+1,LST(ILST)="~Dispense" D DISPLST 25 S ILST=ILST+1,LST(ILST)="~Route" D ROUTE 26 S ILST=ILST+1,LST(ILST)="~Schedule" D SCHED 27 S ILST=ILST+1,LST(ILST)="~Guideline" D GUIDE 28 S ILST=ILST+1,LST(ILST)="~Message" D OIMSG 29 S ILST=ILST+1,LST(ILST)="~DEASchedule" ;PKI 30 ;S ILST=ILST+1,LST(ILST)="d"_$P($G(ORDOSE("DEA")),U) ;PKI 31 S ILST=ILST+1,LST(ILST)="d" ;PKI 32 I $D(ORDOSE("DEA")) S X="",X1=$P(ORDOSE("DEA"),";"),X2=$P(ORDOSE("DEA"),";",2) D 33 . I '$L(X2) Q 34 . I $G(PKIACTIV)="Y" S X=X2 35 S LST(ILST)=LST(ILST)_X 36 I PSTYPE="U" D 37 . ; start, expires, next admin 38 I PSTYPE="O" D 39 . ; days supply, quantity, refills 40 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J) 41 Q 42 ; 43 PTINSTR ; from OISLCT, set up patient instructions 44 N I 45 S I=0 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S ILST=ILST+1,LST(ILST)="t"_ORDOSE("PI",I) 46 Q 47 DOSAGE ; from OISLCT, set up the list of dosages 48 ; LST(n)=iDrugName^Strength^NF^... (see BLDDOSE) 49 ; must be called after ALLDOSE so ORWDOSES is set up 50 N I 51 S I=0 F S I=$O(ORWDOSES(I)) Q:I'>0 S ILST=ILST+1,LST(ILST)=ORWDOSES(I) 52 Q 53 DISPLST ; from OISLCT, set up list of dispense drugs 54 ; DrugIEN^Strength^Units^Name^Split 55 N DD 56 S DD=0 F S DD=$O(ORDOSE("DD",DD)) Q:'DD D 57 . S ILST=ILST+1 58 . S LST(ILST)="i"_DD_U_$P(ORDOSE("DD",DD),U,5,6)_U_$P(ORDOSE("DD",DD),U)_U_$P(ORDOSE("DD",DD),U,11) 59 Q 60 ALLDOSE ; from OISLCT, set up a list of all possible doses 61 ; LST(n)=iDrugName^Strength^NF^... (see BLDDOSE) 62 N I,J,CONJ,DD,DRUG,DDNM,LDOSE,TEXT,STREN,UD,COST,NF,ID,X 63 S CONJ=$P($G(ORDOSE("MISC")),U,3),ORWDOSES=0 64 S:$L(CONJ) CONJ=" "_CONJ_" " S:'$L(CONJ) CONJ=" " 65 S I=0 F S I=$O(ORDOSE(I)) Q:I'>0 D 66 . S X=$$BLDDOSE(ORDOSE(I)) 67 . S ORWDOSES=ORWDOSES+1,ORWDOSES(ORWDOSES)=X 68 . S ILST=ILST+1 69 . S LST(ILST)="i"_$P(X,U,5)_U_$P($P(X,U,4),"&",6)_U_$P(X,U,4) 70 . S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D 71 . . S X=$$BLDDOSE(ORDOSE(I,J)) 72 . . S ILST=ILST+1 73 . . S LST(ILST)="i"_$P(X,U,5)_U_$P($P(X,U,4),"&",6)_U_$P(X,U,4) 74 Q 75 BLDDOSE(X) ; build dose info where X is ORDOSE node 76 ; from ALLDOSE 77 ; X=TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN 78 ; Y=iDrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug&Stren&Units^ 79 ; DoseText^CostText^MaxRefills^DispUnits^CanSplit 80 ; DRUG=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills^ 81 ; No TotalDose, use LocalDose 82 ; TotalDose & Strength, use LocalDose+Conjunction+Strength+Units 83 ; TotalDose, No Strength, use LocalDose+Conjunction+DispenseName 84 S DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD),DDNM=$P(DRUG,U),ID=$P(X,U,1,6) 85 S LDOSE=$P(X,U,5),TEXT=LDOSE,STREN=$P(DRUG,U,5)_$P(DRUG,U,6) 86 S $P(ID,U,7)=$P(DRUG,U,5) S $P(ID,U,8)=$P(DRUG,U,6) ; add strength 87 I '$L($P(X,U)),$L($P(DRUG,U,5)) S TEXT=TEXT_CONJ_STREN 88 I '$L($P(X,U)),'$L($P(DRUG,U,5)) S TEXT=TEXT_CONJ_$P(DRUG,U) 89 S UD=$P(X,U,3),COST=$P(X,U,7),NF=$S($P(DRUG,U,3):"NF",1:"") 90 ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4) 91 S Y="i"_DDNM_U_STREN_U_NF_U_$TR(ID,U,"&")_U_TEXT_U_COST_U_$P(DRUG,U,8)_U_$P(DRUG,U,4) 92 Q Y 93 ROUTE ; from OISLCT, get list of routes for the drug form 94 ; ** NEED BOTH ABBREVIATION & NAME IN LIST BOX 95 N I,CNT,ABBR,IEN,ROUT,EXP,X 96 S I="" F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D 97 . S X=^TMP("PSJMR",$J,I) 98 . S ROUT=$P(X,U),ABBR=$P(X,U,2),IEN=$P(X,U,3),EXP=$P(X,U,4) 99 . S ILST=ILST+1,LST(ILST)="i"_IEN_U_ROUT_U_ABBR_U_EXP_U_$P(X,U,5) 100 . I $P(X,U,6)="D",IEN S ILST=ILST+1,LST(ILST)="d"_IEN_U_ROUT ;_U_ABBR ; assume first always default 101 ; add abbreviations to list of routes, commented out for 15.5 on 102 ; S I="" F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D 103 ; . S X=^TMP("PSJMR",$J,I) 104 ; . S ROUT=$P(X,U),ABBR=$P(X,U,2),IEN=$P(X,U,3),EXP=$P(X,U,4) 105 ; . I $L(ABBR),(ABBR'=ROUT) S ILST=ILST+1,LST(ILST)="i"_IEN_U_ABBR_" ("_ROUT_")"_U_ABBR_U_EXP 106 Q 107 SCHED ; from OISLCT, get default schedule for this medication 108 I $L($G(^TMP("PSJSCH",$J))) S ILST=ILST+1,LST(ILST)="d"_^($J) 109 Q 110 GUIDE ; from OISLCT, get guidelines associated with this medication 111 N IEN,I 112 S IEN=0 F S IEN=$O(^TMP("PSSDIN",$J,"OI",ORWPSOI,IEN)) Q:'IEN D 113 . S I=0 F S I=$O(^TMP("PSSDIN",$J,"OI",ORWPSOI,IEN,I)) Q:'I D 114 . . S ILST=ILST+1,LST(ILST)="t"_^TMP("PSSDIN",$J,"OI",ORWPSOI,IEN,I) 115 Q 116 OIMSG ; from OISLCT, get the orderable item message for this medication 117 S I=0 F S I=$O(^ORD(101.43,OI,8,I)) Q:I'>0 S ILST=ILST+1,LST(ILST)="t"_^(I,0) 118 Q 119 ADMIN(REC,DFN,SCH,OI,LOC) ; return administration time info 120 ; REC: StartText^StartTime^Duration^FirstAdmin 121 S OI=+$P($G(^ORD(101.43,+OI,0)),U,2) 122 S LOC=+$G(^SC(LOC,42)),REC="" 123 I $L($G(^DPT(DFN,.1))) S REC=$$FIRST^ORCDPS3(DFN,LOC,OI,SCH) 124 Q 125 REQST(VAL,DFN,SCH,OI,LOC,TXT) ; return requested start time 126 ; VAL: FirstAdmin time 127 S VAL="" 128 Q:'$L($G(SCH)) Q:'$G(OI) 129 S OI=+$P($G(^ORD(101.43,+OI,0)),U,2) 130 S LOC=+$G(^SC(LOC,42)) 131 S VAL=$P($$RESOLVE^PSJORPOE(DFN,SCH,OI,TXT,LOC),U,2) 132 Q 133 DAY2QTY(VAL,DAY,UPD,SCH,DUR,PAT,DRG) ; return qty for days supply 134 ; VAL: quantity 135 N ORWX,I,X,ADUR,ADURNM 136 S ORWX("DAYS SUPPLY")=DAY 137 S ORWX("PATIENT")=PAT 138 I DRG S ORWX("DRUG")=DRG 139 F I=1:1:$L(UPD,U)-1 D 140 . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I) 141 . S ORWX("SCHEDULE",I)=$P(SCH,U,I) 142 . S ADUR=$P(DUR,U,I),ADURNM=$P($P(ADUR," ",2),"~") 143 . S:ADURNM="MONTHS" X=+ADUR_"L" 144 . S:ADURNM'="MONTHS" X=+ADUR_$E($P(ADUR," ",2)) 145 . I $L(X) S ORWX("DURATION",I)=X 146 . S X=$E($P(ADUR,"~",2)) 147 . I $L(X) S ORWX("CONJUNCTION",I)=X 148 D QTYX^PSOSIG(.ORWX) 149 S VAL=$G(ORWX("QTY")) 150 Q 151 QTY2DAY(VAL,QTY,UPD,SCH,DUR,PAT,DRG) ; return days supply given quantity 152 ; VAL: days supply 153 N ORWX,I,X,ADUR 154 S ORWX("QTY")=QTY 155 S ORWX("PATIENT")=PAT 156 I DRG S ORWX("DRUG")=DRG 157 F I=1:1:$L(UPD,U)-1 D 158 . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I) 159 . S ORWX("SCHEDULE",I)=$P(SCH,U,I) 160 . S ADUR=$P(DUR,U,I),X=+ADUR_$E($P(ADUR," ",2)) 161 . I $L(X) S ORWX("DURATION",I)=X 162 . S X=$E($P(ADUR,"~",2)) 163 . I $L(X) S ORWX("CONJUNCTION",I)=X 164 D QTYX^PSOSIG(.ORWX) 165 S VAL=$G(ORWX("DAYS SUPPLY")) 166 Q 167 MAXREF(VAL,PAT,DRG,SUP,OI,OUT) ; return the maximum number of refills 168 ; PAT=Patient DFN, DRG=ptr50, SUP=days supply, OI=orderable item 169 ; VAL: maximum refills allowed 170 N ORWX 171 S ORWX("PATIENT")=PAT 172 I $G(DRG) S ORWX("DRUG")=+DRG 173 I $G(SUP) S ORWX("DAYS SUPPLY")=SUP 174 I $G(OI) S ORWX("ITEM")=+$P(^ORD(101.43,+OI,0),U,2) 175 I $G(OUT) S ORWX("DISCHARGE")=1 176 D MAX^PSOSIGDS(.ORWX) 177 S VAL=$G(ORWX("MAX")) 178 Q 179 SCHREQ(VAL,OI,RTE,DRG) ; return 1 if schedule is required 180 ; OI=orderable item, RTE=ptr route, DRG=ptr dispense drug 181 S VAL=1 182 Q:'$G(OI) Q:'$G(RTE) 183 S VAL=$$SCHREQ^PSJORPOE(RTE,OI,+$G(DRG)) 184 Q 185 CHKPI(VAL,ODIFN) ; return pre-existing patient instruct 186 N IDNUM,IDPI 187 S (IDNUM,IDPI)=0,VAL="" 188 I '$D(^OR(100,ODIFN,4.5,"ID","PI")) S VAL="" Q 189 F S IDNUM=$O(^OR(100,ODIFN,4.5,"ID","PI",IDNUM)) Q:'IDNUM D 190 . F S IDPI=$O(^OR(100,ODIFN,4.5,IDNUM,2,IDPI)) Q:'IDPI D 191 .. S VAL=VAL_^OR(100,ODIFN,4.5,IDNUM,2,IDPI,0) 192 K IDNUM,IDPI 193 Q 194 CHKGRP(VAL,ORIFN) ; 195 ;Inpatient Med Order Group or Clin Meds Group: return 1 196 ;If order belong to Outpatient Med Order Grpoup: return 2 197 ;Otherwise, return 0 198 S VAL=0 199 I '$L(ORIFN) Q 200 N UDGRP,IPGRP,OPGRP,ODGRP,ODID,CLMED 201 S ODID=+ORIFN 202 Q:ODID<1 203 S (UDGRP,IPGRP,OPGRP,ODGRP,CLMED)=0 204 S UDGRP=$O(^ORD(100.98,"B","UD RX",UDGRP)) 205 S OPGRP=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",OPGRP)) 206 S IPGRP=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",IPGRP)) 207 S CLMED=$O(^ORD(100.98,"B","CLINIC ORDERS",CLMED)) 208 S:IPGRP=0 IPGRP=$O(^ORD(100.98,"B","I RX",IPGRP)) 209 I $L($G(^OR(100,ODID,0)))<1 Q 210 S ODGRP=$P(^OR(100,ODID,0),U,11) 211 I (UDGRP=ODGRP)!(CLMED=ODGRP) S VAL=1 212 I IPGRP=ODGRP S VAL=1 213 I OPGRP=ODGRP S VAL=2 214 K UDGRP,ODGRP,OPGRP,IPGRP,ODID,CLMED 215 Q 216 QOGRP(VAL,QOIFN) ; 217 ;If quick order belong to Inpatient Med Order Group: return 1 218 ;Otherwise, return 0 219 S VAL=0 220 I '$L(QOIFN) Q 221 N UDGRP,IPGRP,QOGRP,QOID,CLMED 222 S QOID=+QOIFN 223 Q:QOID<1 224 S (UDGRP,IPGRP,QOGRP,CLMED)=0 225 S UDGRP=$O(^ORD(100.98,"B","UD RX",UDGRP)) 226 S IPGRP=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",IPGRP)) 227 S CLMED=$O(^ORD(100.98,"B","CLINIC ORDERS",CLMED)) 228 S:IPGRP=0 IPGRP=$O(^ORD(100.98,"B","I RX",IPGRP)) 229 I $L($G(^ORD(101.41,QOID,0)))<1 Q 230 S QOGRP=$P(^ORD(101.41,QOID,0),U,5) 231 I UDGRP=QOGRP S VAL=1 232 I (IPGRP=QOGRP)!(CLMED=QOGRP) S VAL=1 233 K UDGRP,QOGRP,QOID,IPGRP,CLMED 234 Q
Note:
See TracChangeset
for help on using the changeset viewer.
