PSSDSPOP ;BIR/RTR-Populate Dose Unit and Numeric Dose on PSS*1*129 install ;05/03/08
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
;
;Called from PSSPO129 to auto-populate Dose unit and numeric Dose Fields in File 50
;
ENX ;
Q
;
;
TEST(PSSVWIEN) ;Test to see if Numeric Dose and Dose Unit should be prompted for
;In Drug Enter/Edit and Dosage Enter/Options
N PSSVWND1,PSSVWND3,PSSVWZR,PSSVWDOV,PSSVWNDF,PSSVWDF
S PSSVWZR=$G(^PSDRUG(+PSSVWIEN,0))
I $P(PSSVWZR,"^",3)["S"!($E($P(PSSVWZR,"^",2),1,2)="XA") Q 0
S PSSVWND1=$P($G(^PSDRUG(+PSSVWIEN,"ND")),"^"),PSSVWND3=$P($G(^PSDRUG(+PSSVWIEN,"ND")),"^",3)
S PSSVWDOV=""
I PSSVWND1,PSSVWND3,$T(OVRIDE^PSNAPIS)]"" S PSSVWDOV=$$OVRIDE^PSNAPIS(PSSVWND1,PSSVWND3)
I PSSVWND1,PSSVWND3 S PSSVWNDF=$$DFSU^PSNAPIS(PSSVWND1,PSSVWND3) S PSSVWDF=$P(PSSVWNDF,"^")
I $G(PSSVWDF)'>0,$P($G(^PSDRUG(PSSVWIEN,2)),"^") S PSSVWDF=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSVWIEN,2)),"^"),0)),"^",2)
I PSSVWDOV=""!('$G(PSSVWDF))!($P($G(^PS(50.606,+$G(PSSVWDF),1)),"^")="") Q 1
I $P($G(^PS(50.606,+$G(PSSVWDF),1)),"^"),'PSSVWDOV Q 0
I '$P($G(^PS(50.606,+$G(PSSVWDF),1)),"^"),PSSVWDOV Q 0
Q 1
;
;
MS ;Called from Drug Enter Edit and Dose Enter Edit
N PSSVWX,PSSVWXX,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
S PSSVWX=$S($E($G(PSSNATST),1)=".":"0"_$G(PSSNATST),1:$G(PSSNATST))
S PSSVWXX=$S($E($P($G(^PSDRUG(PSSIEN,"DOS")),"^"),1)=".":"0"_$P($G(^PSDRUG(PSSIEN,"DOS")),"^"),1:$P($G(^PSDRUG(PSSIEN,"DOS")),"^"))
I PSSVWX'="",PSSVWXX'="",PSSVWX'=PSSVWXX W !!,"Please note: Strength of drug does not match strength of VA Product it is",!,"matched to." D
.I $G(PSSDESTP) K DIR W ! S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
Q
;
EN ;
;Finish adding data
D ^PSSDSDAT
N PSSQVNMX,PSSQVIEN,PSSQVZR,PSSQVND1,PSSQVND3,PSSQVTOT,PSSQVOK,PSSQVLPX,PSSQVLC1,PSSQVLCD,PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVFZ,PSSQVMUL
N X,Y,DIC,DTOUT,DLAYGO,PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVQT,PSSQVDF8,PSSQV9,PSSQVNUM,PSSQVRSL,PSSQVFNC,PSSQVFNX,PSSQVNDF,PSSQVDF
N PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVFL9,PSSQVFL8,PSSQVFZA
S PSSQVTOT=0
S PSSQVNMX="" F S PSSQVNMX=$O(^PSDRUG("B",PSSQVNMX)) Q:PSSQVNMX="" F PSSQVIEN=0:0 S PSSQVIEN=$O(^PSDRUG("B",PSSQVNMX,PSSQVIEN)) Q:'PSSQVIEN D
.K PSSQVZR,PSSQVND1,PSSQVND3,PSSQVOK,PSSQVLPX,PSSQVLC1,PSSQVLCD,PSSQVDF1,PSSQVDF2,PSSQVDF3
.S PSSQVZR=$G(^PSDRUG(PSSQVIEN,0)),PSSQVND1=$P($G(^PSDRUG(PSSQVIEN,"ND")),"^"),PSSQVND3=$P($G(^PSDRUG(PSSQVIEN,"ND")),"^",3)
.S PSSQVTOT=PSSQVTOT+1 I '(PSSQVTOT#1000) D BMES^XPDUTL("...still mapping Local Possible Dosages...")
.K PSSQVNDF,PSSQVDF,PSSQVFZ
.S PSSQVFZ=""
.S PSSQVOK=$$TESTX
.Q:'PSSQVOK
.I $G(PSSQVDF) S PSSQVFZ=$P($G(^PS(50.606,PSSQVDF,0)),"^")
.L +^PSDRUG(PSSQVIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T Q
.F PSSQVLPX=0:0 S PSSQVLPX=$O(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX)) Q:'PSSQVLPX S PSSQVLC1=$G(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0)) I $P(PSSQVLC1,"^")'="" I '$P(PSSQVLC1,"^",5),($P(PSSQVLC1,"^",6)="") D
..S PSSQVLCD=$$UP^XLFSTR($P(PSSQVLC1,"^"))
..K PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVQT
..S PSSQVQT=0
..;
..;
..;Condition Set 4 (Part 1)
..I $D(^TMP($J,"PSSQVCS4",PSSQVLCD)) D K Y
...S PSSQVQT=1
...S PSSQVDF1=$P(^TMP($J,"PSSQVCS4",PSSQVLCD),"^"),PSSQVDF2=$P(^TMP($J,"PSSQVCS4",PSSQVLCD),"^",2)
...S PSSQVDF3=$$DFIND(PSSQVDF2) I PSSQVDF3,PSSQVDF1 D
....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVDF3
....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVDF1
..Q:PSSQVQT
..;
..;
..;Condition Set 4 (Part 2)
..D CS4
..Q:PSSQVQT
..;
..;
..;Condition Set 1
..I $P($G(PSSQVNDF),"^",4)'="",$P($G(PSSQVNDF),"^",6)'="" D
...I PSSQVFZ["TAB"!(PSSQVFZ["CAP")!(PSSQVFZ="GUM,CHEWABLE")!(PSSQVFZ="IMPLANT")!(PSSQVFZ="LOZENGE")!(PSSQVFZ="SUPP,RTL")!(PSSQVFZ="TROCHE")!(PSSQVFZ="INJ/IMPLANT") D
....I $P(PSSQVNDF,"^",6)="MG"!($P(PSSQVNDF,"^",6)="MCG")!($P(PSSQVNDF,"^",6)="UNT")!($P(PSSQVNDF,"^",6)="GM")!($P(PSSQVNDF,"^",6)="MEQ") D
.....S PSSQVQT=1
.....K PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVDF8,PSSQVMUL
.....S PSSQVDF4=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^"),PSSQVDF5=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
.....I PSSQVDF5 K X S X=$P($G(^PS(50.607,PSSQVDF5,0)),"^") I X'="" S PSSQVDF6=$$DFIND(X)
.....I '$G(PSSQVDF6) K X S X=$P(PSSQVNDF,"^",6) S PSSQVDF6=$$DFIND(X)
.....K Y,X I '$G(PSSQVDF6) Q
.....S PSSQVDF7=$S($G(PSSQVDF4)'="":$G(PSSQVDF4),$P(PSSQVNDF,"^",4)'="":$P(PSSQVNDF,"^",4),1:"")
.....I PSSQVDF7'?.N&(PSSQVDF7'?.N1".".N) K PSSQVDF7
.....Q:$G(PSSQVDF7)=""
.....S PSSQVDF8=$$NUM^PSSDSPON
.....Q:'PSSQVDF8
.....S PSSQVMUL=PSSQVDF8*PSSQVDF7
.....K:+PSSQVMUL'=PSSQVMUL!(PSSQVMUL>99999999999999)!(PSSQVMUL<.00001)!(PSSQVMUL?.E1"."6N.N) PSSQVMUL
.....I '$G(PSSQVMUL) Q
.....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVDF6
.....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVMUL
..Q:$G(PSSQVQT)
..;
..;
..;Condition Set 2
..I $P($G(PSSQVNDF),"^",4)'="",$P($G(PSSQVNDF),"^",6)'="" D
...K PSSQV9,PSSQVFL8,PSSQVFZA
...S PSSQV9=$P(PSSQVNDF,"^",6)
...I PSSQVFZ="ELIXIR"!(PSSQVFZ="LIQUID")!(PSSQVFZ="LIQUID,ORAL")!(PSSQVFZ="PWDR,RENST-ORAL")!(PSSQVFZ="SOLN,CONC")!(PSSQVFZ="SOLN,ORAL")!(PSSQVFZ="SUSP")!(PSSQVFZ="SUSP,ORAL")!(PSSQVFZ="SYRUP")!(PSSQVFZ="SYRUP,ORAL") S PSSQVFZA=1
...I PSSQVFZ="INJ"!(PSSQVFZ="INJ,SOLN") S PSSQVFZA=1
...I $G(PSSQVFZA) D
....I PSSQV9="GM/ML"!(PSSQV9="GM/1ML")!(PSSQV9="GM/5ML")!(PSSQV9="GM/10ML")!(PSSQV9="GM/15ML")!(PSSQV9="GM/30ML") S PSSQVFL8=1
....I PSSQV9="MG/ML"!(PSSQV9="MG/1ML")!(PSSQV9="MG/5ML")!(PSSQV9="MG/10ML")!(PSSQV9="MG/15ML")!(PSSQV9="MG/30ML")!(PSSQV9="MEQ/ML")!(PSSQV9="MEQ/1ML")!(PSSQV9="MEQ/5ML")!(PSSQV9="MEQ/10ML")!(PSSQV9="MEQ/15ML")!(PSSQV9="MEQ/30ML") S PSSQVFL8=1
....I $G(PSSQVFL8) D
.....S PSSQVQT=1
.....K PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVNUM,PSSQVFL9
.....S PSSQVXF4=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^"),PSSQVXF5=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
.....I PSSQVXF5 K X S X=$P($G(^PS(50.607,PSSQVXF5,0)),"^") D
......S PSSQVFL9=0
......I X="GM/ML"!(X="GM/1ML")!(X="GM/5ML")!(X="GM/10ML")!(X="GM/15ML")!(X="GM/30ML") S PSSQVFL9=1
......I X="MG/ML"!(X="MG/1ML")!(X="MG/5ML")!(X="MG/10ML")!(X="MG/15ML")!(X="MG/30ML")!(X="MEQ/ML")!(X="MEQ/1ML")!(X="MEQ/5ML")!(X="MEQ/10ML")!(X="MEQ/15ML")!(X="MEQ/30ML") S PSSQVFL9=1
......Q:'PSSQVFL9
......S PSSQVXF8=$P(X,"/") S PSSQVNUM=+$P(X,"/",2) S PSSQVXF6=$$DFIND(PSSQVXF8)
.....I '$G(PSSQVXF6) K PSSQVNUM,PSSQVXF6 K X S X=PSSQV9 S PSSQVXF9=$P(X,"/") S PSSQVXF6=$$DFIND(PSSQVXF9) S PSSQVNUM=+$P(PSSQV9,"/",2)
.....I '$G(PSSQVXF6) Q
.....I PSSQVNUM'=0,PSSQVNUM'=1,PSSQVNUM'=5,PSSQVNUM'=10,PSSQVNUM'=15,PSSQVNUM'=30 Q
.....I PSSQVNUM=0 S PSSQVNUM=1
.....S PSSQVXF7=$S($G(PSSQVXF4)'="":$G(PSSQVXF4),$P(PSSQVNDF,"^",4)'="":$P(PSSQVNDF,"^",4),1:"")
.....I PSSQVXF7'?.N&(PSSQVXF7'?.N1".".N) K PSSQVXF7
.....Q:$G(PSSQVXF7)=""
.....I '$D(^TMP($J,"PSSQVCS2",PSSQVLCD,PSSQVNUM)) Q
.....K PSSQVFNX,PSSQVRSL,PSSQVFNC
.....S PSSQVRSL=$P(^TMP($J,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^"),PSSQVFNC=$P(^TMP($J,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^",2)
.....I PSSQVFNC="M" S PSSQVFNX=PSSQVXF7*PSSQVRSL
.....I PSSQVFNC="D" S PSSQVFNX=PSSQVXF7/PSSQVRSL
.....Q:$G(PSSQVFNX)=""
.....I +PSSQVFNX'=PSSQVFNX!(PSSQVFNX>99999999999999)!(PSSQVFNX<.00001)!(PSSQVFNX?.E1"."6N.N) Q
.....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVXF6
.....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVFNX
..Q:$G(PSSQVQT)
..;
..;
..;Condition Set 3
..I $P($G(PSSQVNDF),"^",4)'="",$P($G(PSSQVNDF),"^",6)'="" D
...N PSSQVPK1,PSSQVPK2,PSSQVPK3,PSSQVPK4,PSSQVPK5,PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
...S PSSQVPK1=$P(PSSQVNDF,"^",6)
...S PSSQVPK3=0 F PSSQVPK2=1:1:$L(PSSQVPK1) I $E(PSSQVPK1,PSSQVPK2)="/" S PSSQVPK3=PSSQVPK3+1
...I PSSQVPK3=1,$P(PSSQVPK1,"/",2)="PKT" D
....S PSSQVQT=1
....S PSSQVPK4=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^"),PSSQVPK5=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
....K PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
....I PSSQVPK5 S PSSQVPK6=$P($G(^PS(50.607,PSSQVPK5,0)),"^") D
.....S PSSQVPK3=0 F PSSQVPK2=1:1:$L(PSSQVPK6) I $E(PSSQVPK6,PSSQVPK2)="/" S PSSQVPK3=PSSQVPK3+1
.....I PSSQVPK3=1,$P(PSSQVPK6,"/",2)="PKT" S PSSQVPK7=$P(PSSQVPK6,"/") S PSSQVPK8=$$DFIND(PSSQVPK7)
....I '$G(PSSQVPK8) K PSSQVPK8 S PSSQVPK9=$P(PSSQVPK1,"/") S PSSQVPK8=$$DFIND(PSSQVPK9)
....I '$G(PSSQVPK8) Q
....S PSSQVPKZ=$S($G(PSSQVPK4)'="":$G(PSSQVPK4),$P(PSSQVNDF,"^",4)'="":$P(PSSQVNDF,"^",4),1:"")
....I PSSQVPKZ'?.N&(PSSQVPKZ'?.N1".".N) K PSSQVPKZ
....Q:$G(PSSQVPKZ)=""
....S PSSQVPKB=$$NUM^PSSDSPON
....Q:'PSSQVPKB
....S PSSQVPKA=PSSQVPKZ*PSSQVPKB
....I +PSSQVPKA'=PSSQVPKA!(PSSQVPKA>99999999999999)!(PSSQVPKA<.00001)!(PSSQVPKA?.E1"."6N.N) Q
....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVPK8
....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVPKA
..Q:$G(PSSQVQT)
..;
..;
..;Condition set 5
..I PSSQVND1,PSSQVND3,$P($G(PSSQVNDF),"^",4)="",$P($G(PSSQVNDF),"^",6)="" D
...I $D(^TMP($J,"PSSQVCS5",PSSQVLCD)) D
....N PSSQVF51,PSSQVF52,PSSQVF53
....S PSSQVF51=$P(^TMP($J,"PSSQVCS5",PSSQVLCD),"^"),PSSQVF52=$P(^TMP($J,"PSSQVCS5",PSSQVLCD),"^",2)
....S PSSQVF53=$$DFIND(PSSQVF52) I PSSQVF51,PSSQVF53 D
.....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVF53
.....S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVF51
.D ULK
K ^TMP($J,"PSSQVCS2")
K ^TMP($J,"PSSQVCS4")
K ^TMP($J,"PSSQVCS5")
Q
;
ULK ;
L -^PSDRUG(PSSQVIEN)
Q
;
TESTX() ;See if drug needs Dose Unit and Numeric Dose defined
I 'PSSQVND3!('PSSQVND1) Q 0
I $P($G(^PSDRUG(PSSQVIEN,"I")),"^"),$P($G(^PSDRUG(PSSQVIEN,"I")),"^")<DT Q 0
N PSSQVDOV
S PSSQVDOV=""
I PSSQVND1,PSSQVND3,$T(OVRIDE^PSNAPIS)]"" S PSSQVDOV=$$OVRIDE^PSNAPIS(PSSQVND1,PSSQVND3)
I '$O(^PSDRUG(PSSQVIEN,"DOS2",0)) Q 0
I $P(PSSQVZR,"^",3)["S"!($E($P(PSSQVZR,"^",2),1,2)="XA") Q 0
I PSSQVND1,PSSQVND3 S PSSQVNDF=$$DFSU^PSNAPIS(PSSQVND1,PSSQVND3) S PSSQVDF=$P(PSSQVNDF,"^")
I $G(PSSQVDF)'>0,$P($G(^PSDRUG(PSSQVIEN,2)),"^") S PSSQVDF=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSQVIEN,2)),"^"),0)),"^",2)
I PSSQVDOV=""!('$G(PSSQVDF))!($P($G(^PS(50.606,+$G(PSSQVDF),1)),"^")="") Q 1
I $P($G(^PS(50.606,+$G(PSSQVDF),1)),"^"),'PSSQVDOV Q 0
I '$P($G(^PS(50.606,+$G(PSSQVDF),1)),"^"),PSSQVDOV Q 0
Q 1
;
CS4 ;
I PSSQVLCD?.N1" UNITS" D CS4ST Q
I PSSQVLCD?.N1" UNIT" D CS4ST Q
I PSSQVLCD?.N1" UNIT(S)" D CS4ST Q
I PSSQVLCD?.N1" UNT" D CS4ST Q
I PSSQVLCD?.N1" UNT(S)" D CS4ST Q
I PSSQVLCD?.N1" UNTS" D CS4ST Q
I PSSQVLCD?.N1".".N1" UNITS" D CS4ST Q
I PSSQVLCD?.N1".".N1" UNIT" D CS4ST Q
I PSSQVLCD?.N1".".N1" UNIT(S)" D CS4ST Q
I PSSQVLCD?.N1".".N1" UNT" D CS4ST Q
I PSSQVLCD?.N1".".N1" UNT(S)" D CS4ST Q
I PSSQVLCD?.N1".".N1" UNTS" D CS4ST Q
D COMMA
Q
;
CS4ST ;
S PSSQVQT=1
N PSSQVXXX,PSSQVD11,PSSQVD12
S PSSQVXXX=+PSSQVLCD
K:+PSSQVXXX'=PSSQVXXX!(PSSQVXXX>99999999999999)!(PSSQVXXX<.00001)!(PSSQVXXX?.E1"."6N.N) PSSQVXXX
I '$G(PSSQVXXX) Q
S PSSQVD12="UNIT(S)"
S PSSQVD11=$$DFIND(PSSQVD12) I PSSQVD11 D
.S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVD11
.S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVXXX
K Y
Q
;
NUM() ;Only checking combinations of "one-half to one" and "one to two"
;** This section of code was only called in test v1, now uses routine PSSDSPON **
;Doing trailing space, because something like 10,000 Units (with comma), would have gotten by condition set 4
;Combinations of "one-half to one"
I PSSQVLCD["ONE-HALF ",PSSQVLCD["ONE ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR " Q 1
I PSSQVLCD["ONE HALF ",PSSQVLCD["ONE ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR " Q 1
;Removed PSSQVLCD'["2 " because 1/2 space would contain 2 space, is that ok, could probably remove 3 and 4
I PSSQVLCD["1/2 ",PSSQVLCD["1 ",PSSQVLCD'["3 ",PSSQVLCD'["4 " Q 1
;Combinations of "one to two"
I PSSQVLCD["ONE ",PSSQVLCD["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE-HALF " Q 2
I PSSQVLCD["ONE ",PSSQVLCD["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE HALF " Q 2
I PSSQVLCD["1 ",PSSQVLCD["2 ",PSSQVLCD'["3 ",PSSQVLCD'["4 ",PSSQVLCD'["1/2 " Q 2
;Checking for 0.5
I PSSQVLCD["ONE-HALF ",PSSQVLCD'["ONE ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR " Q .5
I PSSQVLCD["ONE HALF ",PSSQVLCD'["ONE ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR " Q .5
;Removed PSSQVLCD'["2 " because 1/2 space would contain 2 space, is that ok, could probably remove 3 and 4
I PSSQVLCD["1/2 ",PSSQVLCD'["1 ",PSSQVLCD'["3 ",PSSQVLCD'["4 " Q .5
;Checking for 1
I PSSQVLCD["ONE ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE-HALF " Q 1
I PSSQVLCD["ONE ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE HALF " Q 1
I PSSQVLCD["1 ",PSSQVLCD'["2 ",PSSQVLCD'["3 ",PSSQVLCD'["4 ",PSSQVLCD'["1/2 " Q 1
;Checking for 2
I PSSQVLCD["TWO ",PSSQVLCD'["ONE ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE-HALF " Q 2
I PSSQVLCD["TWO ",PSSQVLCD'["ONE ",PSSQVLCD'["THREE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE HALF " Q 2
I PSSQVLCD["2 ",PSSQVLCD'["1 ",PSSQVLCD'["3 ",PSSQVLCD'["4 ",PSSQVLCD'["1/2 " Q 2
;Checking for 3
I PSSQVLCD["THREE ",PSSQVLCD'["TWO ",PSSQVLCD'["ONE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE-HALF " Q 3
I PSSQVLCD["THREE ",PSSQVLCD'["TWO ",PSSQVLCD'["ONE ",PSSQVLCD'["FOUR ",PSSQVLCD'["ONE HALF " Q 3
I PSSQVLCD["3 ",PSSQVLCD'["2 ",PSSQVLCD'["1 ",PSSQVLCD'["4 ",PSSQVLCD'["1/2 " Q 3
;Checking for 4
I PSSQVLCD["FOUR ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["ONE ",PSSQVLCD'["ONE-HALF " Q 4
I PSSQVLCD["FOUR ",PSSQVLCD'["TWO ",PSSQVLCD'["THREE ",PSSQVLCD'["ONE ",PSSQVLCD'["ONE HALF " Q 4
I PSSQVLCD["4 ",PSSQVLCD'["2 ",PSSQVLCD'["3 ",PSSQVLCD'["1 ",PSSQVLCD'["1/2 " Q 4
Q 0
;
DFIND(PSSQVFND) ;Fine IEN, can't do DIC Lookup because of exact match check
N PSSQVFN1
S PSSQVFN1=$O(^PS(51.24,"B",PSSQVFND,0)) I PSSQVFN1,'$$SCREEN^XTID(51.24,.01,PSSQVFN1_",") Q PSSQVFN1
S PSSQVFN1=$O(^PS(51.24,"C",PSSQVFND,0)) I PSSQVFN1,'$$SCREEN^XTID(51.24,.01,PSSQVFN1_",") Q PSSQVFN1
S PSSQVFN1=$O(^PS(51.24,"D",PSSQVFND,0)) I PSSQVFN1,'$$SCREEN^XTID(51.24,.01,PSSQVFN1_",") Q PSSQVFN1
Q 0
;
COMMA ;
N PSSQVCM1,PSSQVCM2,PSSQVCM3,PSSQVCM4
I PSSQVLCD'[" " Q
S PSSQVCM1=$P(PSSQVLCD," ")
S PSSQVCM3=$F(PSSQVLCD," ")
S PSSQVCM2=$TR(PSSQVCM1,",","")
S PSSQVCM4=PSSQVCM2_$E(PSSQVLCD,(PSSQVCM3-1),$L(PSSQVLCD))
I PSSQVCM4?.N1" UNITS" D CS4ST1 Q
I PSSQVCM4?.N1" UNIT" D CS4ST1 Q
I PSSQVCM4?.N1" UNIT(S)" D CS4ST1 Q
I PSSQVCM4?.N1" UNT" D CS4ST1 Q
I PSSQVCM4?.N1" UNT(S)" D CS4ST1 Q
I PSSQVCM4?.N1" UNTS" D CS4ST1 Q
Q
;
CS4ST1 ;
S PSSQVQT=1
N PSSQVCM5,PSSQVCM6,PSSQVCM7
S PSSQVCM5=+PSSQVCM4
K:+PSSQVCM5'=PSSQVCM5!(PSSQVCM5>99999999999999)!(PSSQVCM5<.00001)!(PSSQVCM5?.E1"."6N.N) PSSQVCM5
I '$G(PSSQVCM5) Q
S PSSQVCM7="UNIT(S)"
S PSSQVCM6=$$DFIND(PSSQVCM7) I PSSQVCM6 D
.S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVCM6
.S $P(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVCM5
K Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSPOP 15093 printed Dec 13, 2024@02:31:23 Page 2
PSSDSPOP ;BIR/RTR-Populate Dose Unit and Numeric Dose on PSS*1*129 install ;05/03/08
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
+2 ;
+3 ;Called from PSSPO129 to auto-populate Dose unit and numeric Dose Fields in File 50
+4 ;
ENX ;
+1 QUIT
+2 ;
+3 ;
TEST(PSSVWIEN) ;Test to see if Numeric Dose and Dose Unit should be prompted for
+1 ;In Drug Enter/Edit and Dosage Enter/Options
+2 NEW PSSVWND1,PSSVWND3,PSSVWZR,PSSVWDOV,PSSVWNDF,PSSVWDF
+3 SET PSSVWZR=$GET(^PSDRUG(+PSSVWIEN,0))
+4 IF $PIECE(PSSVWZR,"^",3)["S"!($EXTRACT($PIECE(PSSVWZR,"^",2),1,2)="XA")
QUIT 0
+5 SET PSSVWND1=$PIECE($GET(^PSDRUG(+PSSVWIEN,"ND")),"^")
SET PSSVWND3=$PIECE($GET(^PSDRUG(+PSSVWIEN,"ND")),"^",3)
+6 SET PSSVWDOV=""
+7 IF PSSVWND1
IF PSSVWND3
IF $TEXT(OVRIDE^PSNAPIS)]""
SET PSSVWDOV=$$OVRIDE^PSNAPIS(PSSVWND1,PSSVWND3)
+8 IF PSSVWND1
IF PSSVWND3
SET PSSVWNDF=$$DFSU^PSNAPIS(PSSVWND1,PSSVWND3)
SET PSSVWDF=$PIECE(PSSVWNDF,"^")
+9 IF $GET(PSSVWDF)'>0
IF $PIECE($GET(^PSDRUG(PSSVWIEN,2)),"^")
SET PSSVWDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSVWIEN,2)),"^"),0)),"^",2)
+10 IF PSSVWDOV=""!('$GET(PSSVWDF))!($PIECE($GET(^PS(50.606,+$GET(PSSVWDF),1)),"^")="")
QUIT 1
+11 IF $PIECE($GET(^PS(50.606,+$GET(PSSVWDF),1)),"^")
IF 'PSSVWDOV
QUIT 0
+12 IF '$PIECE($GET(^PS(50.606,+$GET(PSSVWDF),1)),"^")
IF PSSVWDOV
QUIT 0
+13 QUIT 1
+14 ;
+15 ;
MS ;Called from Drug Enter Edit and Dose Enter Edit
+1 NEW PSSVWX,PSSVWXX,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET PSSVWX=$SELECT($EXTRACT($GET(PSSNATST),1)=".":"0"_$GET(PSSNATST),1:$GET(PSSNATST))
+3 SET PSSVWXX=$SELECT($EXTRACT($PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^"),1)=".":"0"_$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^"),1:$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^"))
+4 IF PSSVWX'=""
IF PSSVWXX'=""
IF PSSVWX'=PSSVWXX
WRITE !!,"Please note: Strength of drug does not match strength of VA Product it is",!,"matched to."
Begin DoDot:1
+5 IF $GET(PSSDESTP)
KILL DIR
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
End DoDot:1
+6 QUIT
+7 ;
EN ;
+1 ;Finish adding data
+2 DO ^PSSDSDAT
+3 NEW PSSQVNMX,PSSQVIEN,PSSQVZR,PSSQVND1,PSSQVND3,PSSQVTOT,PSSQVOK,PSSQVLPX,PSSQVLC1,PSSQVLCD,PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVFZ,PSSQVMUL
+4 NEW X,Y,DIC,DTOUT,DLAYGO,PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVQT,PSSQVDF8,PSSQV9,PSSQVNUM,PSSQVRSL,PSSQVFNC,PSSQVFNX,PSSQVNDF,PSSQVDF
+5 NEW PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVFL9,PSSQVFL8,PSSQVFZA
+6 SET PSSQVTOT=0
+7 SET PSSQVNMX=""
FOR
SET PSSQVNMX=$ORDER(^PSDRUG("B",PSSQVNMX))
if PSSQVNMX=""
QUIT
FOR PSSQVIEN=0:0
SET PSSQVIEN=$ORDER(^PSDRUG("B",PSSQVNMX,PSSQVIEN))
if 'PSSQVIEN
QUIT
Begin DoDot:1
+8 KILL PSSQVZR,PSSQVND1,PSSQVND3,PSSQVOK,PSSQVLPX,PSSQVLC1,PSSQVLCD,PSSQVDF1,PSSQVDF2,PSSQVDF3
+9 SET PSSQVZR=$GET(^PSDRUG(PSSQVIEN,0))
SET PSSQVND1=$PIECE($GET(^PSDRUG(PSSQVIEN,"ND")),"^")
SET PSSQVND3=$PIECE($GET(^PSDRUG(PSSQVIEN,"ND")),"^",3)
+10 SET PSSQVTOT=PSSQVTOT+1
IF '(PSSQVTOT#1000)
DO BMES^XPDUTL("...still mapping Local Possible Dosages...")
+11 KILL PSSQVNDF,PSSQVDF,PSSQVFZ
+12 SET PSSQVFZ=""
+13 SET PSSQVOK=$$TESTX
+14 if 'PSSQVOK
QUIT
+15 IF $GET(PSSQVDF)
SET PSSQVFZ=$PIECE($GET(^PS(50.606,PSSQVDF,0)),"^")
+16 LOCK +^PSDRUG(PSSQVIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
QUIT
+17 FOR PSSQVLPX=0:0
SET PSSQVLPX=$ORDER(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX))
if 'PSSQVLPX
QUIT
SET PSSQVLC1=$GET(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0))
IF $PIECE(PSSQVLC1,"^")'=""
IF '$PIECE(PSSQVLC1,"^",5)
IF ($PIECE(PSSQVLC1,"^",6)="")
Begin DoDot:2
+18 SET PSSQVLCD=$$UP^XLFSTR($PIECE(PSSQVLC1,"^"))
+19 KILL PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVQT
+20 SET PSSQVQT=0
+21 ;
+22 ;
+23 ;Condition Set 4 (Part 1)
+24 IF $DATA(^TMP($JOB,"PSSQVCS4",PSSQVLCD))
Begin DoDot:3
+25 SET PSSQVQT=1
+26 SET PSSQVDF1=$PIECE(^TMP($JOB,"PSSQVCS4",PSSQVLCD),"^")
SET PSSQVDF2=$PIECE(^TMP($JOB,"PSSQVCS4",PSSQVLCD),"^",2)
+27 SET PSSQVDF3=$$DFIND(PSSQVDF2)
IF PSSQVDF3
IF PSSQVDF1
Begin DoDot:4
+28 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVDF3
+29 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVDF1
End DoDot:4
End DoDot:3
KILL Y
+30 if PSSQVQT
QUIT
+31 ;
+32 ;
+33 ;Condition Set 4 (Part 2)
+34 DO CS4
+35 if PSSQVQT
QUIT
+36 ;
+37 ;
+38 ;Condition Set 1
+39 IF $PIECE($GET(PSSQVNDF),"^",4)'=""
IF $PIECE($GET(PSSQVNDF),"^",6)'=""
Begin DoDot:3
+40 IF PSSQVFZ["TAB"!(PSSQVFZ["CAP")!(PSSQVFZ="GUM,CHEWABLE")!(PSSQVFZ="IMPLANT")!(PSSQVFZ="LOZENGE")!(PSSQVFZ="SUPP,RTL")!(PSSQVFZ="TROCHE")!(PSSQVFZ="INJ/IMPLANT")
Begin DoDot:4
+41 IF $PIECE(PSSQVNDF,"^",6)="MG"!($PIECE(PSSQVNDF,"^",6)="MCG")!($PIECE(PSSQVNDF,"^",6)="UNT")!($PIECE(PSSQVNDF,"^",6)="GM")!($PIECE(PSSQVNDF,"^",6)="MEQ")
Begin DoDot:5
+42 SET PSSQVQT=1
+43 KILL PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVDF8,PSSQVMUL
+44 SET PSSQVDF4=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^")
SET PSSQVDF5=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
+45 IF PSSQVDF5
KILL X
SET X=$PIECE($GET(^PS(50.607,PSSQVDF5,0)),"^")
IF X'=""
SET PSSQVDF6=$$DFIND(X)
+46 IF '$GET(PSSQVDF6)
KILL X
SET X=$PIECE(PSSQVNDF,"^",6)
SET PSSQVDF6=$$DFIND(X)
+47 KILL Y,X
IF '$GET(PSSQVDF6)
QUIT
+48 SET PSSQVDF7=$SELECT($GET(PSSQVDF4)'="":$GET(PSSQVDF4),$PIECE(PSSQVNDF,"^",4)'="":$PIECE(PSSQVNDF,"^",4),1:"")
+49 IF PSSQVDF7'?.N&(PSSQVDF7'?.N1".".N)
KILL PSSQVDF7
+50 if $GET(PSSQVDF7)=""
QUIT
+51 SET PSSQVDF8=$$NUM^PSSDSPON
+52 if 'PSSQVDF8
QUIT
+53 SET PSSQVMUL=PSSQVDF8*PSSQVDF7
+54 if +PSSQVMUL'=PSSQVMUL!(PSSQVMUL>99999999999999)!(PSSQVMUL<.00001)!(PSSQVMUL?.E1"."6N.N)
KILL PSSQVMUL
+55 IF '$GET(PSSQVMUL)
QUIT
+56 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVDF6
+57 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVMUL
End DoDot:5
End DoDot:4
End DoDot:3
+58 if $GET(PSSQVQT)
QUIT
+59 ;
+60 ;
+61 ;Condition Set 2
+62 IF $PIECE($GET(PSSQVNDF),"^",4)'=""
IF $PIECE($GET(PSSQVNDF),"^",6)'=""
Begin DoDot:3
+63 KILL PSSQV9,PSSQVFL8,PSSQVFZA
+64 SET PSSQV9=$PIECE(PSSQVNDF,"^",6)
+65 IF PSSQVFZ="ELIXIR"!(PSSQVFZ="LIQUID")!(PSSQVFZ="LIQUID,ORAL")!(PSSQVFZ="PWDR,RENST-ORAL")!(PSSQVFZ="SOLN,CONC")!(PSSQVFZ="SOLN,ORAL")!(PSSQVFZ="SUSP")!(PSSQVFZ="SUSP,ORAL")!(PSSQVFZ="SYRUP")!(PSSQVFZ
="SYRUP,ORAL")
SET PSSQVFZA=1
+66 IF PSSQVFZ="INJ"!(PSSQVFZ="INJ,SOLN")
SET PSSQVFZA=1
+67 IF $GET(PSSQVFZA)
Begin DoDot:4
+68 IF PSSQV9="GM/ML"!(PSSQV9="GM/1ML")!(PSSQV9="GM/5ML")!(PSSQV9="GM/10ML")!(PSSQV9="GM/15ML")!(PSSQV9="GM/30ML")
SET PSSQVFL8=1
+69 IF PSSQV9="MG/ML"!(PSSQV9="MG/1ML")!(PSSQV9="MG/5ML")!(PSSQV9="MG/10ML")!(PSSQV9="MG/15ML")!(PSSQV9="MG/30ML")!(PSSQV9="MEQ/ML")!(PSSQV9="MEQ/1ML")!(PSSQV9="MEQ/5ML")!(PSSQV9="MEQ/10ML")!(PSSQ
V9="MEQ/15ML")!(PSSQV9="MEQ/30ML")
SET PSSQVFL8=1
+70 IF $GET(PSSQVFL8)
Begin DoDot:5
+71 SET PSSQVQT=1
+72 KILL PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVNUM,PSSQVFL9
+73 SET PSSQVXF4=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^")
SET PSSQVXF5=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
+74 IF PSSQVXF5
KILL X
SET X=$PIECE($GET(^PS(50.607,PSSQVXF5,0)),"^")
Begin DoDot:6
+75 SET PSSQVFL9=0
+76 IF X="GM/ML"!(X="GM/1ML")!(X="GM/5ML")!(X="GM/10ML")!(X="GM/15ML")!(X="GM/30ML")
SET PSSQVFL9=1
+77 IF X="MG/ML"!(X="MG/1ML")!(X="MG/5ML")!(X="MG/10ML")!(X="MG/15ML")!(X="MG/30ML")!(X="MEQ/ML")!(X="MEQ/1ML")!(X="MEQ/5ML")!(X="MEQ/10ML")!(X="MEQ/15ML")!(X="MEQ/30ML")
SET PSSQVFL9=1
+78 if 'PSSQVFL9
QUIT
+79 SET PSSQVXF8=$PIECE(X,"/")
SET PSSQVNUM=+$PIECE(X,"/",2)
SET PSSQVXF6=$$DFIND(PSSQVXF8)
End DoDot:6
+80 IF '$GET(PSSQVXF6)
KILL PSSQVNUM,PSSQVXF6
KILL X
SET X=PSSQV9
SET PSSQVXF9=$PIECE(X,"/")
SET PSSQVXF6=$$DFIND(PSSQVXF9)
SET PSSQVNUM=+$PIECE(PSSQV9,"/",2)
+81 IF '$GET(PSSQVXF6)
QUIT
+82 IF PSSQVNUM'=0
IF PSSQVNUM'=1
IF PSSQVNUM'=5
IF PSSQVNUM'=10
IF PSSQVNUM'=15
IF PSSQVNUM'=30
QUIT
+83 IF PSSQVNUM=0
SET PSSQVNUM=1
+84 SET PSSQVXF7=$SELECT($GET(PSSQVXF4)'="":$GET(PSSQVXF4),$PIECE(PSSQVNDF,"^",4)'="":$PIECE(PSSQVNDF,"^",4),1:"")
+85 IF PSSQVXF7'?.N&(PSSQVXF7'?.N1".".N)
KILL PSSQVXF7
+86 if $GET(PSSQVXF7)=""
QUIT
+87 IF '$DATA(^TMP($JOB,"PSSQVCS2",PSSQVLCD,PSSQVNUM))
QUIT
+88 KILL PSSQVFNX,PSSQVRSL,PSSQVFNC
+89 SET PSSQVRSL=$PIECE(^TMP($JOB,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^")
SET PSSQVFNC=$PIECE(^TMP($JOB,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^",2)
+90 IF PSSQVFNC="M"
SET PSSQVFNX=PSSQVXF7*PSSQVRSL
+91 IF PSSQVFNC="D"
SET PSSQVFNX=PSSQVXF7/PSSQVRSL
+92 if $GET(PSSQVFNX)=""
QUIT
+93 IF +PSSQVFNX'=PSSQVFNX!(PSSQVFNX>99999999999999)!(PSSQVFNX<.00001)!(PSSQVFNX?.E1"."6N.N)
QUIT
+94 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVXF6
+95 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVFNX
End DoDot:5
End DoDot:4
End DoDot:3
+96 if $GET(PSSQVQT)
QUIT
+97 ;
+98 ;
+99 ;Condition Set 3
+100 IF $PIECE($GET(PSSQVNDF),"^",4)'=""
IF $PIECE($GET(PSSQVNDF),"^",6)'=""
Begin DoDot:3
+101 NEW PSSQVPK1,PSSQVPK2,PSSQVPK3,PSSQVPK4,PSSQVPK5,PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
+102 SET PSSQVPK1=$PIECE(PSSQVNDF,"^",6)
+103 SET PSSQVPK3=0
FOR PSSQVPK2=1:1:$LENGTH(PSSQVPK1)
IF $EXTRACT(PSSQVPK1,PSSQVPK2)="/"
SET PSSQVPK3=PSSQVPK3+1
+104 IF PSSQVPK3=1
IF $PIECE(PSSQVPK1,"/",2)="PKT"
Begin DoDot:4
+105 SET PSSQVQT=1
+106 SET PSSQVPK4=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^")
SET PSSQVPK5=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
+107 KILL PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
+108 IF PSSQVPK5
SET PSSQVPK6=$PIECE($GET(^PS(50.607,PSSQVPK5,0)),"^")
Begin DoDot:5
+109 SET PSSQVPK3=0
FOR PSSQVPK2=1:1:$LENGTH(PSSQVPK6)
IF $EXTRACT(PSSQVPK6,PSSQVPK2)="/"
SET PSSQVPK3=PSSQVPK3+1
+110 IF PSSQVPK3=1
IF $PIECE(PSSQVPK6,"/",2)="PKT"
SET PSSQVPK7=$PIECE(PSSQVPK6,"/")
SET PSSQVPK8=$$DFIND(PSSQVPK7)
End DoDot:5
+111 IF '$GET(PSSQVPK8)
KILL PSSQVPK8
SET PSSQVPK9=$PIECE(PSSQVPK1,"/")
SET PSSQVPK8=$$DFIND(PSSQVPK9)
+112 IF '$GET(PSSQVPK8)
QUIT
+113 SET PSSQVPKZ=$SELECT($GET(PSSQVPK4)'="":$GET(PSSQVPK4),$PIECE(PSSQVNDF,"^",4)'="":$PIECE(PSSQVNDF,"^",4),1:"")
+114 IF PSSQVPKZ'?.N&(PSSQVPKZ'?.N1".".N)
KILL PSSQVPKZ
+115 if $GET(PSSQVPKZ)=""
QUIT
+116 SET PSSQVPKB=$$NUM^PSSDSPON
+117 if 'PSSQVPKB
QUIT
+118 SET PSSQVPKA=PSSQVPKZ*PSSQVPKB
+119 IF +PSSQVPKA'=PSSQVPKA!(PSSQVPKA>99999999999999)!(PSSQVPKA<.00001)!(PSSQVPKA?.E1"."6N.N)
QUIT
+120 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVPK8
+121 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVPKA
End DoDot:4
End DoDot:3
+122 if $GET(PSSQVQT)
QUIT
+123 ;
+124 ;
+125 ;Condition set 5
+126 IF PSSQVND1
IF PSSQVND3
IF $PIECE($GET(PSSQVNDF),"^",4)=""
IF $PIECE($GET(PSSQVNDF),"^",6)=""
Begin DoDot:3
+127 IF $DATA(^TMP($JOB,"PSSQVCS5",PSSQVLCD))
Begin DoDot:4
+128 NEW PSSQVF51,PSSQVF52,PSSQVF53
+129 SET PSSQVF51=$PIECE(^TMP($JOB,"PSSQVCS5",PSSQVLCD),"^")
SET PSSQVF52=$PIECE(^TMP($JOB,"PSSQVCS5",PSSQVLCD),"^",2)
+130 SET PSSQVF53=$$DFIND(PSSQVF52)
IF PSSQVF51
IF PSSQVF53
Begin DoDot:5
+131 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVF53
+132 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVF51
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+133 DO ULK
End DoDot:1
+134 KILL ^TMP($JOB,"PSSQVCS2")
+135 KILL ^TMP($JOB,"PSSQVCS4")
+136 KILL ^TMP($JOB,"PSSQVCS5")
+137 QUIT
+138 ;
ULK ;
+1 LOCK -^PSDRUG(PSSQVIEN)
+2 QUIT
+3 ;
TESTX() ;See if drug needs Dose Unit and Numeric Dose defined
+1 IF 'PSSQVND3!('PSSQVND1)
QUIT 0
+2 IF $PIECE($GET(^PSDRUG(PSSQVIEN,"I")),"^")
IF $PIECE($GET(^PSDRUG(PSSQVIEN,"I")),"^")<DT
QUIT 0
+3 NEW PSSQVDOV
+4 SET PSSQVDOV=""
+5 IF PSSQVND1
IF PSSQVND3
IF $TEXT(OVRIDE^PSNAPIS)]""
SET PSSQVDOV=$$OVRIDE^PSNAPIS(PSSQVND1,PSSQVND3)
+6 IF '$ORDER(^PSDRUG(PSSQVIEN,"DOS2",0))
QUIT 0
+7 IF $PIECE(PSSQVZR,"^",3)["S"!($EXTRACT($PIECE(PSSQVZR,"^",2),1,2)="XA")
QUIT 0
+8 IF PSSQVND1
IF PSSQVND3
SET PSSQVNDF=$$DFSU^PSNAPIS(PSSQVND1,PSSQVND3)
SET PSSQVDF=$PIECE(PSSQVNDF,"^")
+9 IF $GET(PSSQVDF)'>0
IF $PIECE($GET(^PSDRUG(PSSQVIEN,2)),"^")
SET PSSQVDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSQVIEN,2)),"^"),0)),"^",2)
+10 IF PSSQVDOV=""!('$GET(PSSQVDF))!($PIECE($GET(^PS(50.606,+$GET(PSSQVDF),1)),"^")="")
QUIT 1
+11 IF $PIECE($GET(^PS(50.606,+$GET(PSSQVDF),1)),"^")
IF 'PSSQVDOV
QUIT 0
+12 IF '$PIECE($GET(^PS(50.606,+$GET(PSSQVDF),1)),"^")
IF PSSQVDOV
QUIT 0
+13 QUIT 1
+14 ;
CS4 ;
+1 IF PSSQVLCD?.N1" UNITS"
DO CS4ST
QUIT
+2 IF PSSQVLCD?.N1" UNIT"
DO CS4ST
QUIT
+3 IF PSSQVLCD?.N1" UNIT(S)"
DO CS4ST
QUIT
+4 IF PSSQVLCD?.N1" UNT"
DO CS4ST
QUIT
+5 IF PSSQVLCD?.N1" UNT(S)"
DO CS4ST
QUIT
+6 IF PSSQVLCD?.N1" UNTS"
DO CS4ST
QUIT
+7 IF PSSQVLCD?.N1".".N1" UNITS"
DO CS4ST
QUIT
+8 IF PSSQVLCD?.N1".".N1" UNIT"
DO CS4ST
QUIT
+9 IF PSSQVLCD?.N1".".N1" UNIT(S)"
DO CS4ST
QUIT
+10 IF PSSQVLCD?.N1".".N1" UNT"
DO CS4ST
QUIT
+11 IF PSSQVLCD?.N1".".N1" UNT(S)"
DO CS4ST
QUIT
+12 IF PSSQVLCD?.N1".".N1" UNTS"
DO CS4ST
QUIT
+13 DO COMMA
+14 QUIT
+15 ;
CS4ST ;
+1 SET PSSQVQT=1
+2 NEW PSSQVXXX,PSSQVD11,PSSQVD12
+3 SET PSSQVXXX=+PSSQVLCD
+4 if +PSSQVXXX'=PSSQVXXX!(PSSQVXXX>99999999999999)!(PSSQVXXX<.00001)!(PSSQVXXX?.E1"."6N.N)
KILL PSSQVXXX
+5 IF '$GET(PSSQVXXX)
QUIT
+6 SET PSSQVD12="UNIT(S)"
+7 SET PSSQVD11=$$DFIND(PSSQVD12)
IF PSSQVD11
Begin DoDot:1
+8 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVD11
+9 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVXXX
End DoDot:1
+10 KILL Y
+11 QUIT
+12 ;
NUM() ;Only checking combinations of "one-half to one" and "one to two"
+1 ;** This section of code was only called in test v1, now uses routine PSSDSPON **
+2 ;Doing trailing space, because something like 10,000 Units (with comma), would have gotten by condition set 4
+3 ;Combinations of "one-half to one"
+4 IF PSSQVLCD["ONE-HALF "
IF PSSQVLCD["ONE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
QUIT 1
+5 IF PSSQVLCD["ONE HALF "
IF PSSQVLCD["ONE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
QUIT 1
+6 ;Removed PSSQVLCD'["2 " because 1/2 space would contain 2 space, is that ok, could probably remove 3 and 4
+7 IF PSSQVLCD["1/2 "
IF PSSQVLCD["1 "
IF PSSQVLCD'["3 "
IF PSSQVLCD'["4 "
QUIT 1
+8 ;Combinations of "one to two"
+9 IF PSSQVLCD["ONE "
IF PSSQVLCD["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE-HALF "
QUIT 2
+10 IF PSSQVLCD["ONE "
IF PSSQVLCD["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE HALF "
QUIT 2
+11 IF PSSQVLCD["1 "
IF PSSQVLCD["2 "
IF PSSQVLCD'["3 "
IF PSSQVLCD'["4 "
IF PSSQVLCD'["1/2 "
QUIT 2
+12 ;Checking for 0.5
+13 IF PSSQVLCD["ONE-HALF "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
QUIT .5
+14 IF PSSQVLCD["ONE HALF "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
QUIT .5
+15 ;Removed PSSQVLCD'["2 " because 1/2 space would contain 2 space, is that ok, could probably remove 3 and 4
+16 IF PSSQVLCD["1/2 "
IF PSSQVLCD'["1 "
IF PSSQVLCD'["3 "
IF PSSQVLCD'["4 "
QUIT .5
+17 ;Checking for 1
+18 IF PSSQVLCD["ONE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE-HALF "
QUIT 1
+19 IF PSSQVLCD["ONE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE HALF "
QUIT 1
+20 IF PSSQVLCD["1 "
IF PSSQVLCD'["2 "
IF PSSQVLCD'["3 "
IF PSSQVLCD'["4 "
IF PSSQVLCD'["1/2 "
QUIT 1
+21 ;Checking for 2
+22 IF PSSQVLCD["TWO "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE-HALF "
QUIT 2
+23 IF PSSQVLCD["TWO "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE HALF "
QUIT 2
+24 IF PSSQVLCD["2 "
IF PSSQVLCD'["1 "
IF PSSQVLCD'["3 "
IF PSSQVLCD'["4 "
IF PSSQVLCD'["1/2 "
QUIT 2
+25 ;Checking for 3
+26 IF PSSQVLCD["THREE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE-HALF "
QUIT 3
+27 IF PSSQVLCD["THREE "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["FOUR "
IF PSSQVLCD'["ONE HALF "
QUIT 3
+28 IF PSSQVLCD["3 "
IF PSSQVLCD'["2 "
IF PSSQVLCD'["1 "
IF PSSQVLCD'["4 "
IF PSSQVLCD'["1/2 "
QUIT 3
+29 ;Checking for 4
+30 IF PSSQVLCD["FOUR "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["ONE-HALF "
QUIT 4
+31 IF PSSQVLCD["FOUR "
IF PSSQVLCD'["TWO "
IF PSSQVLCD'["THREE "
IF PSSQVLCD'["ONE "
IF PSSQVLCD'["ONE HALF "
QUIT 4
+32 IF PSSQVLCD["4 "
IF PSSQVLCD'["2 "
IF PSSQVLCD'["3 "
IF PSSQVLCD'["1 "
IF PSSQVLCD'["1/2 "
QUIT 4
+33 QUIT 0
+34 ;
DFIND(PSSQVFND) ;Fine IEN, can't do DIC Lookup because of exact match check
+1 NEW PSSQVFN1
+2 SET PSSQVFN1=$ORDER(^PS(51.24,"B",PSSQVFND,0))
IF PSSQVFN1
IF '$$SCREEN^XTID(51.24,.01,PSSQVFN1_",")
QUIT PSSQVFN1
+3 SET PSSQVFN1=$ORDER(^PS(51.24,"C",PSSQVFND,0))
IF PSSQVFN1
IF '$$SCREEN^XTID(51.24,.01,PSSQVFN1_",")
QUIT PSSQVFN1
+4 SET PSSQVFN1=$ORDER(^PS(51.24,"D",PSSQVFND,0))
IF PSSQVFN1
IF '$$SCREEN^XTID(51.24,.01,PSSQVFN1_",")
QUIT PSSQVFN1
+5 QUIT 0
+6 ;
COMMA ;
+1 NEW PSSQVCM1,PSSQVCM2,PSSQVCM3,PSSQVCM4
+2 IF PSSQVLCD'[" "
QUIT
+3 SET PSSQVCM1=$PIECE(PSSQVLCD," ")
+4 SET PSSQVCM3=$FIND(PSSQVLCD," ")
+5 SET PSSQVCM2=$TRANSLATE(PSSQVCM1,",","")
+6 SET PSSQVCM4=PSSQVCM2_$EXTRACT(PSSQVLCD,(PSSQVCM3-1),$LENGTH(PSSQVLCD))
+7 IF PSSQVCM4?.N1" UNITS"
DO CS4ST1
QUIT
+8 IF PSSQVCM4?.N1" UNIT"
DO CS4ST1
QUIT
+9 IF PSSQVCM4?.N1" UNIT(S)"
DO CS4ST1
QUIT
+10 IF PSSQVCM4?.N1" UNT"
DO CS4ST1
QUIT
+11 IF PSSQVCM4?.N1" UNT(S)"
DO CS4ST1
QUIT
+12 IF PSSQVCM4?.N1" UNTS"
DO CS4ST1
QUIT
+13 QUIT
+14 ;
CS4ST1 ;
+1 SET PSSQVQT=1
+2 NEW PSSQVCM5,PSSQVCM6,PSSQVCM7
+3 SET PSSQVCM5=+PSSQVCM4
+4 if +PSSQVCM5'=PSSQVCM5!(PSSQVCM5>99999999999999)!(PSSQVCM5<.00001)!(PSSQVCM5?.E1"."6N.N)
KILL PSSQVCM5
+5 IF '$GET(PSSQVCM5)
QUIT
+6 SET PSSQVCM7="UNIT(S)"
+7 SET PSSQVCM6=$$DFIND(PSSQVCM7)
IF PSSQVCM6
Begin DoDot:1
+8 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",5)=PSSQVCM6
+9 SET $PIECE(^PSDRUG(PSSQVIEN,"DOS2",PSSQVLPX,0),"^",6)=PSSQVCM5
End DoDot:1
+10 KILL Y
+11 QUIT
