PSSDSAPL ;BIR/RTR-Free Text Dosage Logic ;06/21/10
;;1.0;PHARMACY DATA MANAGEMENT;**117,160,201,178**;9/30/97;Build 14
;
;
NUM ;Determine Dose Amount and Dose Unit from Free Text Dose
;
;PSSDBV9 = Free Text Dosage
;
N PSSDBV9
S PSSDBV9=$G(PSSDSLCL)
I $L(PSSDBV9)'>0 Q
S PSSDBV9=$$UP^XLFSTR(PSSDBV9)
;
;
N PSSDBV1,PSSDBV2,PSSDBV3,PSSDBV7,PSSDBV8
S PSSDBV3=""
S PSSDBV8=$$NUMF I PSSDBV8 S PSSDBAR("AMN")=PSSDBV8,PSSDBAR("UNIT")=PSSDBV3,PSSDBFAL=1 Q
;
;
I $E(PSSDBV9)="." S PSSDBV9="0"_PSSDBV9 S PSSDBV8=$$NUMF I PSSDBV8 S PSSDBAR("AMN")=PSSDBV8,PSSDBAR("UNIT")=PSSDBV3,PSSDBFAL=1 Q
I $E(PSSDBV9)=0 S PSSDBV9=$E(PSSDBV9,2,$L(PSSDBV9)) S PSSDBV8=$$NUMF I PSSDBV8 S PSSDBAR("AMN")=PSSDBV8,PSSDBAR("UNIT")=PSSDBV3,PSSDBFAL=1
Q
;
;
NUMF() ;
S PSSDBV1=$E(PSSDBV9,1,11) I PSSDBV1="ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,12,$L(PSSDBV9)) Q $S($$8:.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,11) I PSSDBV1="ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,12,$L(PSSDBV9)) Q $S($$8:.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) Q $S($$8:.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,5) I PSSDBV1="0.25 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,6,$L(PSSDBV9)) Q $S($$8:.25,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) Q $S($$8:.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,5) I PSSDBV1="0.33 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,6,$L(PSSDBV9)) Q $S($$8:.33,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,9) I PSSDBV1="ONE HALF ",$$7 S PSSDBV2=$E(PSSDBV9,10,$L(PSSDBV9)) I $$8 Q .5
S PSSDBV1=$E(PSSDBV9,1,9) I PSSDBV1="ONE-HALF ",$$7 S PSSDBV2=$E(PSSDBV9,10,$L(PSSDBV9)) I $$8 Q .5
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="1/2 ",$$7 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) I $$8 Q .5
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="0.5 ",$$7 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) I $$8 Q .5
;
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="0.5-1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,8) I PSSDBV1="0.5 - 1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,9,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,9) I PSSDBV1="0.5 TO 1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,10,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,9) I PSSDBV1="0.5 OR 1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,10,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="1/2-1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,8) I PSSDBV1="1/2 - 1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,9,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,9) I PSSDBV1="1/2 TO 1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,10,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,9) I PSSDBV1="1/2 OR 1 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,10,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="ONE-HALF TO ONE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="ONE - HALF TO ONE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="ONE HALF TO ONE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="ONE-HALF OR ONE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="ONE - HALF OR ONE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:1,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="ONE HALF OR ONE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:1,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,2) I PSSDBV1="1 ",$$7 S PSSDBV2=$E(PSSDBV9,3,$L(PSSDBV9)) I $$8 Q 1
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="ONE ",$$7 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) I $$8 Q 1
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="1 AND 1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:1.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="ONE AND ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:1.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="ONE AND ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:1.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="1 AND ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:1.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="1 AND ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:1.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="ONE AND 1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:1.25,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="1 AND 1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:1.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="ONE AND ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:1.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="ONE AND ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:1.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="1 AND ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:1.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="1 AND ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:1.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="ONE AND 1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:1.33,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="1 AND 1/2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:1.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="ONE AND ONE HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:1.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="ONE AND ONE-HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:1.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="1 AND ONE HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:1.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="1 AND ONE-HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:1.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="ONE AND 1/2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:1.5,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="1-2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="1 - 2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="1 TO 2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="1 OR 2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,11) I PSSDBV1="ONE TO TWO " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,12,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,11) I PSSDBV1="ONE OR TWO " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,12,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,8) I PSSDBV1="ONE-TWO " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,9,$L(PSSDBV9)) Q $S($$8:2,1:0)
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="ONE - TWO " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:2,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,2) I PSSDBV1="2 ",$$7 S PSSDBV2=$E(PSSDBV9,3,$L(PSSDBV9)) I $$8 Q 2
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="TWO ",$$7 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) I $$8 Q 2
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="2 AND 1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:2.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="TWO AND ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:2.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="TWO AND ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:2.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="2 AND ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:2.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="2 AND ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:2.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="TWO AND 1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:2.25,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="2 AND 1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:2.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="TWO AND ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:2.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="TWO AND ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:2.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="2 AND ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:2.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="2 AND ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:2.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="TWO AND 1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:2.33,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="2 AND 1/2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:2.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="TWO AND ONE HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:2.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="TWO AND ONE-HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:2.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="2 AND ONE HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:2.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="2 AND ONE-HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:2.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="TWO AND 1/2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:2.5,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="2-3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="2 - 3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="2 TO 3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="2 OR 3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="TWO TO THREE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="TWO OR THREE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="TWO-THREE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:3,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="TWO - THREE " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:3,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,2) I PSSDBV1="3 ",$$7 S PSSDBV2=$E(PSSDBV9,3,$L(PSSDBV9)) I $$8 Q 3
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="THREE ",$$7 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) I $$8 Q 3
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="3 AND 1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:3.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,21) I PSSDBV1="THREE AND ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,22,$L(PSSDBV9)) Q $S($$8:3.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,21) I PSSDBV1="THREE AND ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,22,$L(PSSDBV9)) Q $S($$8:3.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="3 AND ONE FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:3.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="3 AND ONE-FOURTH " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:3.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,14) I PSSDBV1="THREE AND 1/4 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,15,$L(PSSDBV9)) Q $S($$8:3.25,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="3 AND 1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:3.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,20) I PSSDBV1="THREE AND ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,21,$L(PSSDBV9)) Q $S($$8:3.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,20) I PSSDBV1="THREE AND ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,21,$L(PSSDBV9)) Q $S($$8:3.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="3 AND ONE THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:3.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="3 AND ONE-THIRD " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:3.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,14) I PSSDBV1="THREE AND 1/3 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,15,$L(PSSDBV9)) Q $S($$8:3.33,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="3 AND 1/2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:3.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="THREE AND ONE HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:3.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="THREE AND ONE-HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:3.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="3 AND ONE HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:3.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="3 AND ONE-HALF " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:3.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,14) I PSSDBV1="THREE AND 1/2 " Q:'$$7 0 S PSSDBV2=$E(PSSDBV9,15,$L(PSSDBV9)) Q $S($$8:3.5,1:0)
;
;
S PSSDBV7=$$NUMC^PSSDSBPB Q:PSSDBV7'="" PSSDBV7
S PSSDBV7=$$NUMC^PSSDSBPC Q:PSSDBV7'="" PSSDBV7
S PSSDBV7=$$NUMC^PSSDSBPD Q PSSDBV7
;
;
8() ;Look for Unit - PSSDBIFL set in PSSSAPD, indicates if Order has a Dispense Drug, or just an Orderable Item
S PSSDBV3="" D
.I PSSDBIFL S PSSDBV3=$$UNITD^PSSDSAPI(PSSDBV2) Q
.S PSSDBV3=$$UNIT^PSSDSAPI(PSSDBV2)
Q $S(PSSDBV3="":0,1:1)
;
;
7() ;Validate text follow the numeric part of the text
I $L(PSSDBV9)'>$L(PSSDBV1) Q 0
Q 1
;
TEST ;used for testing numeric dose multiplier from Local Possible Dosage
N X,Y,PSSDBV1,PSSDBV2,PSSDBV3,PSSDBV7,PSSDBV8,DIR,DIRUT,DTOUT,PSSDBIFL
S (PSSDSLCL,PSSDBV3,PSSDBIFL)=""
TEST1 ;
K DIR S DIR("A")="Possible Dosage",DIR(0)="FO^1:40" ;,DIR("?")="Enter a possible dosage for testing numeric dose multiplier."
D ^DIR G TESTE:$G(DIRUT)!($G(DTOUT))!(X="")
K DIR S (PSSDBV9,PSSDSLCL)=Y W !!,$$NUMF^PSSDSAPL,!!
G TEST1
TESTE ;
Q
;
QORDLEM() ; prevent DOSE calls for CPRS when prior drug interaction/drug therapy (DIDT) call
; has flagged a drug level error message for the orderable item for a free text dose
; "OR-TRANSIENT" node set in GCNREASN^PSSHRVL1
; relies on arrays from CPRS use of DIDT call being present
; RTC #163264, RTC #163290
N PSSDIDTB,PSSDIDTD,PSSDIDTO
Q:$G(PSSDBDS("CONTEXT"))'="CPRS-UD" 0
S PSSDIDTO=+$G(PSSDBFDB("OI"))
Q:PSSDIDTO<1 0
Q:$G(PSSDBFDB("PACKAGE"))="" 0
S PSSDIDTB="OROCOUT"_$G(PSSDBFDB("PACKAGE"))_";"
Q:'$D(^TMP($J,PSSDIDTB,"OR-TRANSIENT")) 0
S PSSDIDTD=+$O(^TMP($J,PSSDIDTB,"OR-TRANSIENT",0))
Q $S($D(^PSDRUG("ASP",PSSDIDTO,PSSDIDTD)):1,1:0) ; if drug from DIDT exception is associated with dosing orderable item, stop dosing call
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSAPL 14536 printed Sep 23, 2025@20:06:48 Page 2
PSSDSAPL ;BIR/RTR-Free Text Dosage Logic ;06/21/10
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**117,160,201,178**;9/30/97;Build 14
+2 ;
+3 ;
NUM ;Determine Dose Amount and Dose Unit from Free Text Dose
+1 ;
+2 ;PSSDBV9 = Free Text Dosage
+3 ;
+4 NEW PSSDBV9
+5 SET PSSDBV9=$GET(PSSDSLCL)
+6 IF $LENGTH(PSSDBV9)'>0
QUIT
+7 SET PSSDBV9=$$UP^XLFSTR(PSSDBV9)
+8 ;
+9 ;
+10 NEW PSSDBV1,PSSDBV2,PSSDBV3,PSSDBV7,PSSDBV8
+11 SET PSSDBV3=""
+12 SET PSSDBV8=$$NUMF
IF PSSDBV8
SET PSSDBAR("AMN")=PSSDBV8
SET PSSDBAR("UNIT")=PSSDBV3
SET PSSDBFAL=1
QUIT
+13 ;
+14 ;
+15 IF $EXTRACT(PSSDBV9)="."
SET PSSDBV9="0"_PSSDBV9
SET PSSDBV8=$$NUMF
IF PSSDBV8
SET PSSDBAR("AMN")=PSSDBV8
SET PSSDBAR("UNIT")=PSSDBV3
SET PSSDBFAL=1
QUIT
+16 IF $EXTRACT(PSSDBV9)=0
SET PSSDBV9=$EXTRACT(PSSDBV9,2,$LENGTH(PSSDBV9))
SET PSSDBV8=$$NUMF
IF PSSDBV8
SET PSSDBAR("AMN")=PSSDBV8
SET PSSDBAR("UNIT")=PSSDBV3
SET PSSDBFAL=1
+17 QUIT
+18 ;
+19 ;
NUMF() ;
+1 SET PSSDBV1=$EXTRACT(PSSDBV9,1,11)
IF PSSDBV1="ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,12,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.25,1:0)
+2 SET PSSDBV1=$EXTRACT(PSSDBV9,1,11)
IF PSSDBV1="ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,12,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.25,1:0)
+3 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.25,1:0)
+4 SET PSSDBV1=$EXTRACT(PSSDBV9,1,5)
IF PSSDBV1="0.25 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,6,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.25,1:0)
+5 ;
+6 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.33,1:0)
+7 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.33,1:0)
+8 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.33,1:0)
+9 SET PSSDBV1=$EXTRACT(PSSDBV9,1,5)
IF PSSDBV1="0.33 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,6,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:.33,1:0)
+10 ;
+11 SET PSSDBV1=$EXTRACT(PSSDBV9,1,9)
IF PSSDBV1="ONE HALF "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,10,$LENGTH(PSSDBV9))
IF $$8
QUIT .5
+12 SET PSSDBV1=$EXTRACT(PSSDBV9,1,9)
IF PSSDBV1="ONE-HALF "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,10,$LENGTH(PSSDBV9))
IF $$8
QUIT .5
+13 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="1/2 "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
IF $$8
QUIT .5
+14 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="0.5 "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
IF $$8
QUIT .5
+15 ;
+16 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="0.5-1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+17 SET PSSDBV1=$EXTRACT(PSSDBV9,1,8)
IF PSSDBV1="0.5 - 1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,9,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+18 SET PSSDBV1=$EXTRACT(PSSDBV9,1,9)
IF PSSDBV1="0.5 TO 1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,10,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+19 SET PSSDBV1=$EXTRACT(PSSDBV9,1,9)
IF PSSDBV1="0.5 OR 1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,10,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+20 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="1/2-1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+21 SET PSSDBV1=$EXTRACT(PSSDBV9,1,8)
IF PSSDBV1="1/2 - 1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,9,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+22 SET PSSDBV1=$EXTRACT(PSSDBV9,1,9)
IF PSSDBV1="1/2 TO 1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,10,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+23 SET PSSDBV1=$EXTRACT(PSSDBV9,1,9)
IF PSSDBV1="1/2 OR 1 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,10,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+24 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="ONE-HALF TO ONE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+25 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="ONE - HALF TO ONE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+26 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="ONE HALF TO ONE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+27 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="ONE-HALF OR ONE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+28 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="ONE - HALF OR ONE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+29 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="ONE HALF OR ONE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1,1:0)
+30 ;
+31 SET PSSDBV1=$EXTRACT(PSSDBV9,1,2)
IF PSSDBV1="1 "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,3,$LENGTH(PSSDBV9))
IF $$8
QUIT 1
+32 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="ONE "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
IF $$8
QUIT 1
+33 ;
+34 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="1 AND 1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.25,1:0)
+35 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="ONE AND ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.25,1:0)
+36 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="ONE AND ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.25,1:0)
+37 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="1 AND ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.25,1:0)
+38 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="1 AND ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.25,1:0)
+39 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="ONE AND 1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.25,1:0)
+40 ;
+41 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="1 AND 1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.33,1:0)
+42 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="ONE AND ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.33,1:0)
+43 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="ONE AND ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.33,1:0)
+44 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="1 AND ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.33,1:0)
+45 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="1 AND ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.33,1:0)
+46 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="ONE AND 1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.33,1:0)
+47 ;
+48 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="1 AND 1/2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.5,1:0)
+49 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="ONE AND ONE HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.5,1:0)
+50 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="ONE AND ONE-HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.5,1:0)
+51 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="1 AND ONE HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.5,1:0)
+52 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="1 AND ONE-HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.5,1:0)
+53 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="ONE AND 1/2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:1.5,1:0)
+54 ;
+55 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="1-2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+56 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="1 - 2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+57 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="1 TO 2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+58 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="1 OR 2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+59 SET PSSDBV1=$EXTRACT(PSSDBV9,1,11)
IF PSSDBV1="ONE TO TWO "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,12,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+60 SET PSSDBV1=$EXTRACT(PSSDBV9,1,11)
IF PSSDBV1="ONE OR TWO "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,12,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+61 SET PSSDBV1=$EXTRACT(PSSDBV9,1,8)
IF PSSDBV1="ONE-TWO "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,9,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+62 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="ONE - TWO "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2,1:0)
+63 ;
+64 SET PSSDBV1=$EXTRACT(PSSDBV9,1,2)
IF PSSDBV1="2 "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,3,$LENGTH(PSSDBV9))
IF $$8
QUIT 2
+65 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="TWO "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
IF $$8
QUIT 2
+66 ;
+67 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="2 AND 1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.25,1:0)
+68 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="TWO AND ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.25,1:0)
+69 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="TWO AND ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.25,1:0)
+70 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="2 AND ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.25,1:0)
+71 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="2 AND ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.25,1:0)
+72 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="TWO AND 1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.25,1:0)
+73 ;
+74 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="2 AND 1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.33,1:0)
+75 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="TWO AND ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.33,1:0)
+76 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="TWO AND ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.33,1:0)
+77 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="2 AND ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.33,1:0)
+78 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="2 AND ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.33,1:0)
+79 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="TWO AND 1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.33,1:0)
+80 ;
+81 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="2 AND 1/2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.5,1:0)
+82 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="TWO AND ONE HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.5,1:0)
+83 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="TWO AND ONE-HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.5,1:0)
+84 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="2 AND ONE HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.5,1:0)
+85 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="2 AND ONE-HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.5,1:0)
+86 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="TWO AND 1/2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:2.5,1:0)
+87 ;
+88 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="2-3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+89 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="2 - 3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+90 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="2 TO 3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+91 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="2 OR 3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+92 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="TWO TO THREE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+93 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="TWO OR THREE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+94 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="TWO-THREE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+95 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="TWO - THREE "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3,1:0)
+96 ;
+97 SET PSSDBV1=$EXTRACT(PSSDBV9,1,2)
IF PSSDBV1="3 "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,3,$LENGTH(PSSDBV9))
IF $$8
QUIT 3
+98 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="THREE "
IF $$7
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
IF $$8
QUIT 3
+99 ;
+100 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="3 AND 1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.25,1:0)
+101 SET PSSDBV1=$EXTRACT(PSSDBV9,1,21)
IF PSSDBV1="THREE AND ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,22,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.25,1:0)
+102 SET PSSDBV1=$EXTRACT(PSSDBV9,1,21)
IF PSSDBV1="THREE AND ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,22,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.25,1:0)
+103 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="3 AND ONE FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.25,1:0)
+104 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="3 AND ONE-FOURTH "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.25,1:0)
+105 SET PSSDBV1=$EXTRACT(PSSDBV9,1,14)
IF PSSDBV1="THREE AND 1/4 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,15,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.25,1:0)
+106 ;
+107 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="3 AND 1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.33,1:0)
+108 SET PSSDBV1=$EXTRACT(PSSDBV9,1,20)
IF PSSDBV1="THREE AND ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,21,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.33,1:0)
+109 SET PSSDBV1=$EXTRACT(PSSDBV9,1,20)
IF PSSDBV1="THREE AND ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,21,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.33,1:0)
+110 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="3 AND ONE THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.33,1:0)
+111 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="3 AND ONE-THIRD "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.33,1:0)
+112 SET PSSDBV1=$EXTRACT(PSSDBV9,1,14)
IF PSSDBV1="THREE AND 1/3 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,15,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.33,1:0)
+113 ;
+114 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="3 AND 1/2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.5,1:0)
+115 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="THREE AND ONE HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.5,1:0)
+116 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="THREE AND ONE-HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.5,1:0)
+117 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="3 AND ONE HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.5,1:0)
+118 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="3 AND ONE-HALF "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.5,1:0)
+119 SET PSSDBV1=$EXTRACT(PSSDBV9,1,14)
IF PSSDBV1="THREE AND 1/2 "
if '$$7
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,15,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:3.5,1:0)
+120 ;
+121 ;
+122 SET PSSDBV7=$$NUMC^PSSDSBPB
if PSSDBV7'=""
QUIT PSSDBV7
+123 SET PSSDBV7=$$NUMC^PSSDSBPC
if PSSDBV7'=""
QUIT PSSDBV7
+124 SET PSSDBV7=$$NUMC^PSSDSBPD
QUIT PSSDBV7
+125 ;
+126 ;
8() ;Look for Unit - PSSDBIFL set in PSSSAPD, indicates if Order has a Dispense Drug, or just an Orderable Item
+1 SET PSSDBV3=""
Begin DoDot:1
+2 IF PSSDBIFL
SET PSSDBV3=$$UNITD^PSSDSAPI(PSSDBV2)
QUIT
+3 SET PSSDBV3=$$UNIT^PSSDSAPI(PSSDBV2)
End DoDot:1
+4 QUIT $SELECT(PSSDBV3="":0,1:1)
+5 ;
+6 ;
7() ;Validate text follow the numeric part of the text
+1 IF $LENGTH(PSSDBV9)'>$LENGTH(PSSDBV1)
QUIT 0
+2 QUIT 1
+3 ;
TEST ;used for testing numeric dose multiplier from Local Possible Dosage
+1 NEW X,Y,PSSDBV1,PSSDBV2,PSSDBV3,PSSDBV7,PSSDBV8,DIR,DIRUT,DTOUT,PSSDBIFL
+2 SET (PSSDSLCL,PSSDBV3,PSSDBIFL)=""
TEST1 ;
+1 ;,DIR("?")="Enter a possible dosage for testing numeric dose multiplier."
KILL DIR
SET DIR("A")="Possible Dosage"
SET DIR(0)="FO^1:40"
+2 DO ^DIR
if $GET(DIRUT)!($GET(DTOUT))!(X="")
GOTO TESTE
+3 KILL DIR
SET (PSSDBV9,PSSDSLCL)=Y
WRITE !!,$$NUMF^PSSDSAPL,!!
+4 GOTO TEST1
TESTE ;
+1 QUIT
+2 ;
QORDLEM() ; prevent DOSE calls for CPRS when prior drug interaction/drug therapy (DIDT) call
+1 ; has flagged a drug level error message for the orderable item for a free text dose
+2 ; "OR-TRANSIENT" node set in GCNREASN^PSSHRVL1
+3 ; relies on arrays from CPRS use of DIDT call being present
+4 ; RTC #163264, RTC #163290
+5 NEW PSSDIDTB,PSSDIDTD,PSSDIDTO
+6 if $GET(PSSDBDS("CONTEXT"))'="CPRS-UD"
QUIT 0
+7 SET PSSDIDTO=+$GET(PSSDBFDB("OI"))
+8 if PSSDIDTO<1
QUIT 0
+9 if $GET(PSSDBFDB("PACKAGE"))=""
QUIT 0
+10 SET PSSDIDTB="OROCOUT"_$GET(PSSDBFDB("PACKAGE"))_";"
+11 if '$DATA(^TMP($JOB,PSSDIDTB,"OR-TRANSIENT"))
QUIT 0
+12 SET PSSDIDTD=+$ORDER(^TMP($JOB,PSSDIDTB,"OR-TRANSIENT",0))
+13 ; if drug from DIDT exception is associated with dosing orderable item, stop dosing call
QUIT $SELECT($DATA(^PSDRUG("ASP",PSSDIDTO,PSSDIDTD)):1,1:0)
+14 ;
