PSSDSBPB ;BIR/RTR-Determine numeric dose multiplier for dose call, continued ;02/12/09
;;1.0;PHARMACY DATA MANAGEMENT;**117,160**;9/30/97;Build 76
;
;
NUMX() ;Determine numeric dose multiplier from Local Possible Dosage
;Q $S($$6:4,1:0)
;
S PSSQVJ1=$E(PSSQVLCD,1,5) I PSSQVJ1="0.33 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,6,$L(PSSQVLCD)) Q $S($$6:.33,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,4) I PSSQVJ1="1/3 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,5,$L(PSSQVLCD)) Q $S($$6:.33,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,10) I PSSQVJ1="ONE THIRD " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,11,$L(PSSQVLCD)) Q $S($$6:.33,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,10) I PSSQVJ1="ONE-THIRD " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,11,$L(PSSQVLCD)) Q $S($$6:.33,1:0)
;
S PSSQVJ1=$E(PSSQVLCD,1,5) I PSSQVJ1="0.25 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,6,$L(PSSQVLCD)) Q $S($$6:.25,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,4) I PSSQVJ1="1/4 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,5,$L(PSSQVLCD)) Q $S($$6:.25,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,11) I PSSQVJ1="ONE FOURTH " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,12,$L(PSSQVLCD)) Q $S($$6:.25,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,11) I PSSQVJ1="ONE-FOURTH " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,12,$L(PSSQVLCD)) Q $S($$6:.25,1:0)
;
S PSSQVJ1=$E(PSSQVLCD,1,2) I PSSQVJ1="4 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,3,$L(PSSQVLCD)) Q $S($$6&$$9:4,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,5) I PSSQVJ1="FOUR " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,6,$L(PSSQVLCD)) Q $S($$6&$$9:4,1:0)
;
S PSSQVJ1=$E(PSSQVLCD,1,2) I PSSQVJ1="3 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,3,$L(PSSQVLCD)) Q $S($$6&$$9:3,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,6) I PSSQVJ1="THREE " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,7,$L(PSSQVLCD)) Q $S($$6&$$9:3,1:0)
;
S PSSQVJ1=$E(PSSQVLCD,1,2) I PSSQVJ1="2 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,3,$L(PSSQVLCD)) Q $S($$6&$$9:2,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,4) I PSSQVJ1="TWO " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,5,$L(PSSQVLCD)) Q $S($$6&$$9:2,1:0)
;
S PSSQVJ1=$E(PSSQVLCD,1,2) I PSSQVJ1="1 " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,3,$L(PSSQVLCD)) Q $S($$6&$$9:1,1:0)
S PSSQVJ1=$E(PSSQVLCD,1,4) I PSSQVJ1="ONE " Q:'$$7 0 S PSSQVJ2=$E(PSSQVLCD,5,$L(PSSQVLCD)) Q $S($$6&$$9:1,1:0)
;
Q 0
;
6() ;
;Some special characters in a Nouns will pass, (), etc. others like "/" will not
I PSSQVJ2[" " Q 0
I PSSQVJ2["-" Q 0
I PSSQVJ2["&" Q 0
I PSSQVJ2["\" Q 0
I PSSQVJ2["/" Q 0
Q 1
;
7() ;
I $L(PSSQVLCD)'>$L(PSSQVJ1) Q 0
Q 1
;
9() ;
I PSSQVJ2'["4",PSSQVJ2'["3",PSSQVJ2'["2",PSSQVJ2'["FOURTH",PSSQVJ2'["THIRD",PSSQVJ2'["HALF" Q 1
Q 0
;
;
NUMC() ;Continuation of Free Text Dosage conversion from routine PSSDSAPL
;
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="3-4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="3 - 4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="3 TO 4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="3 OR 4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,14) I PSSDBV1="THREE TO FOUR " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,15,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,14) I PSSDBV1="THREE OR FOUR " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,15,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,11) I PSSDBV1="THREE-FOUR " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,12,$L(PSSDBV9)) Q $S($$8:4,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="THREE - FOUR " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:4,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,2) I PSSDBV1="4 ",$$4 S PSSDBV2=$E(PSSDBV9,3,$L(PSSDBV9)) I $$8 Q 4
S PSSDBV1=$E(PSSDBV9,1,5) I PSSDBV1="FOUR ",$$4 S PSSDBV2=$E(PSSDBV9,6,$L(PSSDBV9)) I $$8 Q 4
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="4 AND 1/4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:4.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,20) I PSSDBV1="FOUR AND ONE FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,21,$L(PSSDBV9)) Q $S($$8:4.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,20) I PSSDBV1="FOUR AND ONE-FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,21,$L(PSSDBV9)) Q $S($$8:4.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="4 AND ONE FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:4.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="4 AND ONE-FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:4.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FOUR AND 1/4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:4.25,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="4 AND 1/3 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:4.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="FOUR AND ONE THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:4.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="FOUR AND ONE-THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:4.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="4 AND ONE THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:4.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="4 AND ONE-THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:4.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FOUR AND 1/3 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:4.33,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="4 AND 1/2 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:4.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="FOUR AND ONE HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:4.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="FOUR AND ONE-HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:4.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="4 AND ONE HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:4.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="4 AND ONE-HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:4.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FOUR AND 1/2 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:4.5,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,4) I PSSDBV1="4-5 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,5,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,6) I PSSDBV1="4 - 5 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,7,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="4 TO 5 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,7) I PSSDBV1="4 OR 5 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,8,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FOUR TO FIVE " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FOUR OR FIVE " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="FOUR-FIVE " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:5,1:0)
S PSSDBV1=$E(PSSDBV9,1,12) I PSSDBV1="FOUR - FIVE " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,13,$L(PSSDBV9)) Q $S($$8:5,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,2) I PSSDBV1="5 ",$$4 S PSSDBV2=$E(PSSDBV9,3,$L(PSSDBV9)) I $$8 Q 5
S PSSDBV1=$E(PSSDBV9,1,5) I PSSDBV1="FIVE ",$$4 S PSSDBV2=$E(PSSDBV9,6,$L(PSSDBV9)) I $$8 Q 5
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="5 AND 1/4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:5.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,20) I PSSDBV1="FIVE AND ONE FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,21,$L(PSSDBV9)) Q $S($$8:5.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,20) I PSSDBV1="FIVE AND ONE-FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,21,$L(PSSDBV9)) Q $S($$8:5.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="5 AND ONE FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:5.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,17) I PSSDBV1="5 AND ONE-FOURTH " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,18,$L(PSSDBV9)) Q $S($$8:5.25,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FIVE AND 1/4 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:5.25,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="5 AND 1/3 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:5.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="FIVE AND ONE THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:5.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,19) I PSSDBV1="FIVE AND ONE-THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,20,$L(PSSDBV9)) Q $S($$8:5.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="5 AND ONE THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:5.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,16) I PSSDBV1="5 AND ONE-THIRD " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,17,$L(PSSDBV9)) Q $S($$8:5.33,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FIVE AND 1/3 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:5.33,1:0)
;
S PSSDBV1=$E(PSSDBV9,1,10) I PSSDBV1="5 AND 1/2 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,11,$L(PSSDBV9)) Q $S($$8:5.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="FIVE AND ONE HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:5.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,18) I PSSDBV1="FIVE AND ONE-HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,19,$L(PSSDBV9)) Q $S($$8:5.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="5 AND ONE HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:5.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,15) I PSSDBV1="5 AND ONE-HALF " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,16,$L(PSSDBV9)) Q $S($$8:5.5,1:0)
S PSSDBV1=$E(PSSDBV9,1,13) I PSSDBV1="FIVE AND 1/2 " Q:'$$4 0 S PSSDBV2=$E(PSSDBV9,14,$L(PSSDBV9)) Q $S($$8:5.5,1:0)
;
;
Q ""
;
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)
;
;
4() ;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,PSSQVLCD,DIR,DIRUT,DTOUT
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 PSSQVLCD=Y W !!,$$NUM^PSSDSBPA,!!
G TEST1
TESTE ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSBPB 9950 printed Jan 18, 2025@03:31:54 Page 2
PSSDSBPB ;BIR/RTR-Determine numeric dose multiplier for dose call, continued ;02/12/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**117,160**;9/30/97;Build 76
+2 ;
+3 ;
NUMX() ;Determine numeric dose multiplier from Local Possible Dosage
+1 ;Q $S($$6:4,1:0)
+2 ;
+3 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,5)
IF PSSQVJ1="0.33 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,6,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.33,1:0)
+4 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,4)
IF PSSQVJ1="1/3 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,5,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.33,1:0)
+5 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,10)
IF PSSQVJ1="ONE THIRD "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,11,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.33,1:0)
+6 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,10)
IF PSSQVJ1="ONE-THIRD "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,11,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.33,1:0)
+7 ;
+8 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,5)
IF PSSQVJ1="0.25 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,6,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.25,1:0)
+9 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,4)
IF PSSQVJ1="1/4 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,5,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.25,1:0)
+10 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,11)
IF PSSQVJ1="ONE FOURTH "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,12,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.25,1:0)
+11 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,11)
IF PSSQVJ1="ONE-FOURTH "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,12,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6:.25,1:0)
+12 ;
+13 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,2)
IF PSSQVJ1="4 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,3,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:4,1:0)
+14 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,5)
IF PSSQVJ1="FOUR "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,6,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:4,1:0)
+15 ;
+16 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,2)
IF PSSQVJ1="3 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,3,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:3,1:0)
+17 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,6)
IF PSSQVJ1="THREE "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,7,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:3,1:0)
+18 ;
+19 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,2)
IF PSSQVJ1="2 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,3,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:2,1:0)
+20 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,4)
IF PSSQVJ1="TWO "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,5,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:2,1:0)
+21 ;
+22 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,2)
IF PSSQVJ1="1 "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,3,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:1,1:0)
+23 SET PSSQVJ1=$EXTRACT(PSSQVLCD,1,4)
IF PSSQVJ1="ONE "
if '$$7
QUIT 0
SET PSSQVJ2=$EXTRACT(PSSQVLCD,5,$LENGTH(PSSQVLCD))
QUIT $SELECT($$6&$$9:1,1:0)
+24 ;
+25 QUIT 0
+26 ;
6() ;
+1 ;Some special characters in a Nouns will pass, (), etc. others like "/" will not
+2 IF PSSQVJ2[" "
QUIT 0
+3 IF PSSQVJ2["-"
QUIT 0
+4 IF PSSQVJ2["&"
QUIT 0
+5 IF PSSQVJ2["\"
QUIT 0
+6 IF PSSQVJ2["/"
QUIT 0
+7 QUIT 1
+8 ;
7() ;
+1 IF $LENGTH(PSSQVLCD)'>$LENGTH(PSSQVJ1)
QUIT 0
+2 QUIT 1
+3 ;
9() ;
+1 IF PSSQVJ2'["4"
IF PSSQVJ2'["3"
IF PSSQVJ2'["2"
IF PSSQVJ2'["FOURTH"
IF PSSQVJ2'["THIRD"
IF PSSQVJ2'["HALF"
QUIT 1
+2 QUIT 0
+3 ;
+4 ;
NUMC() ;Continuation of Free Text Dosage conversion from routine PSSDSAPL
+1 ;
+2 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="3-4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+3 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="3 - 4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+4 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="3 TO 4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+5 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="3 OR 4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+6 SET PSSDBV1=$EXTRACT(PSSDBV9,1,14)
IF PSSDBV1="THREE TO FOUR "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,15,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+7 SET PSSDBV1=$EXTRACT(PSSDBV9,1,14)
IF PSSDBV1="THREE OR FOUR "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,15,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+8 SET PSSDBV1=$EXTRACT(PSSDBV9,1,11)
IF PSSDBV1="THREE-FOUR "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,12,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+9 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="THREE - FOUR "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4,1:0)
+10 ;
+11 SET PSSDBV1=$EXTRACT(PSSDBV9,1,2)
IF PSSDBV1="4 "
IF $$4
SET PSSDBV2=$EXTRACT(PSSDBV9,3,$LENGTH(PSSDBV9))
IF $$8
QUIT 4
+12 SET PSSDBV1=$EXTRACT(PSSDBV9,1,5)
IF PSSDBV1="FOUR "
IF $$4
SET PSSDBV2=$EXTRACT(PSSDBV9,6,$LENGTH(PSSDBV9))
IF $$8
QUIT 4
+13 ;
+14 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="4 AND 1/4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.25,1:0)
+15 SET PSSDBV1=$EXTRACT(PSSDBV9,1,20)
IF PSSDBV1="FOUR AND ONE FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,21,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.25,1:0)
+16 SET PSSDBV1=$EXTRACT(PSSDBV9,1,20)
IF PSSDBV1="FOUR AND ONE-FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,21,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.25,1:0)
+17 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="4 AND ONE FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.25,1:0)
+18 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="4 AND ONE-FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.25,1:0)
+19 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FOUR AND 1/4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.25,1:0)
+20 ;
+21 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="4 AND 1/3 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.33,1:0)
+22 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="FOUR AND ONE THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.33,1:0)
+23 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="FOUR AND ONE-THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.33,1:0)
+24 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="4 AND ONE THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.33,1:0)
+25 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="4 AND ONE-THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.33,1:0)
+26 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FOUR AND 1/3 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.33,1:0)
+27 ;
+28 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="4 AND 1/2 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.5,1:0)
+29 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="FOUR AND ONE HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.5,1:0)
+30 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="FOUR AND ONE-HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.5,1:0)
+31 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="4 AND ONE HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.5,1:0)
+32 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="4 AND ONE-HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.5,1:0)
+33 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FOUR AND 1/2 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:4.5,1:0)
+34 ;
+35 SET PSSDBV1=$EXTRACT(PSSDBV9,1,4)
IF PSSDBV1="4-5 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,5,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+36 SET PSSDBV1=$EXTRACT(PSSDBV9,1,6)
IF PSSDBV1="4 - 5 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,7,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+37 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="4 TO 5 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+38 SET PSSDBV1=$EXTRACT(PSSDBV9,1,7)
IF PSSDBV1="4 OR 5 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,8,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+39 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FOUR TO FIVE "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+40 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FOUR OR FIVE "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+41 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="FOUR-FIVE "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+42 SET PSSDBV1=$EXTRACT(PSSDBV9,1,12)
IF PSSDBV1="FOUR - FIVE "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,13,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5,1:0)
+43 ;
+44 SET PSSDBV1=$EXTRACT(PSSDBV9,1,2)
IF PSSDBV1="5 "
IF $$4
SET PSSDBV2=$EXTRACT(PSSDBV9,3,$LENGTH(PSSDBV9))
IF $$8
QUIT 5
+45 SET PSSDBV1=$EXTRACT(PSSDBV9,1,5)
IF PSSDBV1="FIVE "
IF $$4
SET PSSDBV2=$EXTRACT(PSSDBV9,6,$LENGTH(PSSDBV9))
IF $$8
QUIT 5
+46 ;
+47 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="5 AND 1/4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.25,1:0)
+48 SET PSSDBV1=$EXTRACT(PSSDBV9,1,20)
IF PSSDBV1="FIVE AND ONE FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,21,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.25,1:0)
+49 SET PSSDBV1=$EXTRACT(PSSDBV9,1,20)
IF PSSDBV1="FIVE AND ONE-FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,21,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.25,1:0)
+50 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="5 AND ONE FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.25,1:0)
+51 SET PSSDBV1=$EXTRACT(PSSDBV9,1,17)
IF PSSDBV1="5 AND ONE-FOURTH "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,18,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.25,1:0)
+52 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FIVE AND 1/4 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.25,1:0)
+53 ;
+54 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="5 AND 1/3 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.33,1:0)
+55 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="FIVE AND ONE THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.33,1:0)
+56 SET PSSDBV1=$EXTRACT(PSSDBV9,1,19)
IF PSSDBV1="FIVE AND ONE-THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,20,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.33,1:0)
+57 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="5 AND ONE THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.33,1:0)
+58 SET PSSDBV1=$EXTRACT(PSSDBV9,1,16)
IF PSSDBV1="5 AND ONE-THIRD "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,17,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.33,1:0)
+59 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FIVE AND 1/3 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.33,1:0)
+60 ;
+61 SET PSSDBV1=$EXTRACT(PSSDBV9,1,10)
IF PSSDBV1="5 AND 1/2 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,11,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.5,1:0)
+62 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="FIVE AND ONE HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.5,1:0)
+63 SET PSSDBV1=$EXTRACT(PSSDBV9,1,18)
IF PSSDBV1="FIVE AND ONE-HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,19,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.5,1:0)
+64 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="5 AND ONE HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.5,1:0)
+65 SET PSSDBV1=$EXTRACT(PSSDBV9,1,15)
IF PSSDBV1="5 AND ONE-HALF "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,16,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.5,1:0)
+66 SET PSSDBV1=$EXTRACT(PSSDBV9,1,13)
IF PSSDBV1="FIVE AND 1/2 "
if '$$4
QUIT 0
SET PSSDBV2=$EXTRACT(PSSDBV9,14,$LENGTH(PSSDBV9))
QUIT $SELECT($$8:5.5,1:0)
+67 ;
+68 ;
+69 QUIT ""
+70 ;
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 ;
4() ;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,PSSQVLCD,DIR,DIRUT,DTOUT
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 PSSQVLCD=Y
WRITE !!,$$NUM^PSSDSBPA,!!
+4 GOTO TEST1
TESTE ;
+1 QUIT
