PSSDSBBP ;BIR/RTR-Find Dose Unit and Numeric Dose for Dose Call ;02/12/09
;;1.0;PHARMACY DATA MANAGEMENT;**117**;9/30/97;Build 101
;
EN(PSSQVIEN,PSSQVLCD) ;
;PSSQVIEN = File 50 Internal Entry Number
;PSSQVLCD = Local Possible Dosage
;Find Dose Unit and Numeric Dose, called from PSSDSAPD
I '$G(PSSQVIEN) Q 0
I $G(PSSQVLCD)="" Q 0
D ^PSSDSBDA
N PSSQVSSS,PSSQVND1,PSSQVND3,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 PSSQVSSS=0
I PSSQVIEN D
.K PSSQVND1,PSSQVND3,PSSQVDF1,PSSQVDF2,PSSQVDF3
.S PSSQVND1=$P($G(^PSDRUG(PSSQVIEN,"ND")),"^"),PSSQVND3=$P($G(^PSDRUG(PSSQVIEN,"ND")),"^",3)
.;Next line, quit if not matched to NDF, only because rest of code is relying on PSNAPIS result
.I 'PSSQVND3!('PSSQVND1) Q
.K PSSQVNDF,PSSQVDF,PSSQVFZ
.S PSSQVFZ=""
.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 $G(PSSQVDF) S PSSQVFZ=$P($G(^PS(50.606,PSSQVDF,0)),"^")
.I 1 D
..S PSSQVLCD=$$UP^XLFSTR(PSSQVLCD)
..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 PSSQVSSS=PSSQVDF3_"^"_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^PSSDSBPA
.....Q:'PSSQVDF8
.....S PSSQVMUL=PSSQVDF8*PSSQVDF7
.....K:+PSSQVMUL'=PSSQVMUL!(PSSQVMUL>99999999999999)!(PSSQVMUL<.00001)!(PSSQVMUL?.E1"."6N.N) PSSQVMUL
.....I '$G(PSSQVMUL) Q
.....S PSSQVSSS=PSSQVDF6_"^"_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 PSSQVSSS=PSSQVXF6_"^"_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^PSSDSBPA
....Q:'PSSQVPKB
....S PSSQVPKA=PSSQVPKZ*PSSQVPKB
....I +PSSQVPKA'=PSSQVPKA!(PSSQVPKA>99999999999999)!(PSSQVPKA<.00001)!(PSSQVPKA?.E1"."6N.N) Q
....S PSSQVSSS=PSSQVPK8_"^"_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 PSSQVSSS=PSSQVF53_"^"_PSSQVF51
K ^TMP($J,"PSSQVCS2")
K ^TMP($J,"PSSQVCS4")
K ^TMP($J,"PSSQVCS5")
Q PSSQVSSS
;
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 PSSQVSSS=PSSQVD11_"^"_PSSQVXXX
K Y
Q
;
;
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 PSSQVSSS=PSSQVCM6_"^"_PSSQVCM5
K Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSBBP 9302 printed Apr 09, 2024@21:34:52 Page 2
PSSDSBBP ;BIR/RTR-Find Dose Unit and Numeric Dose for Dose Call ;02/12/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**117**;9/30/97;Build 101
+2 ;
EN(PSSQVIEN,PSSQVLCD) ;
+1 ;PSSQVIEN = File 50 Internal Entry Number
+2 ;PSSQVLCD = Local Possible Dosage
+3 ;Find Dose Unit and Numeric Dose, called from PSSDSAPD
+4 IF '$GET(PSSQVIEN)
QUIT 0
+5 IF $GET(PSSQVLCD)=""
QUIT 0
+6 DO ^PSSDSBDA
+7 NEW PSSQVSSS,PSSQVND1,PSSQVND3,PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVFZ,PSSQVMUL
+8 NEW X,Y,DIC,DTOUT,DLAYGO,PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVQT,PSSQVDF8,PSSQV9,PSSQVNUM,PSSQVRSL,PSSQVFNC,PSSQVFNX,PSSQVNDF,PSSQVDF
+9 NEW PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVFL9,PSSQVFL8,PSSQVFZA
+10 SET PSSQVSSS=0
+11 IF PSSQVIEN
Begin DoDot:1
+12 KILL PSSQVND1,PSSQVND3,PSSQVDF1,PSSQVDF2,PSSQVDF3
+13 SET PSSQVND1=$PIECE($GET(^PSDRUG(PSSQVIEN,"ND")),"^")
SET PSSQVND3=$PIECE($GET(^PSDRUG(PSSQVIEN,"ND")),"^",3)
+14 ;Next line, quit if not matched to NDF, only because rest of code is relying on PSNAPIS result
+15 IF 'PSSQVND3!('PSSQVND1)
QUIT
+16 KILL PSSQVNDF,PSSQVDF,PSSQVFZ
+17 SET PSSQVFZ=""
+18 IF PSSQVND1
IF PSSQVND3
SET PSSQVNDF=$$DFSU^PSNAPIS(PSSQVND1,PSSQVND3)
SET PSSQVDF=$PIECE(PSSQVNDF,"^")
+19 IF $GET(PSSQVDF)'>0
IF $PIECE($GET(^PSDRUG(PSSQVIEN,2)),"^")
SET PSSQVDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSQVIEN,2)),"^"),0)),"^",2)
+20 IF $GET(PSSQVDF)
SET PSSQVFZ=$PIECE($GET(^PS(50.606,PSSQVDF,0)),"^")
+21 IF 1
Begin DoDot:2
+22 SET PSSQVLCD=$$UP^XLFSTR(PSSQVLCD)
+23 KILL PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVQT
+24 SET PSSQVQT=0
+25 ;
+26 ;
+27 ;Condition Set 4 (Part 1)
+28 IF $DATA(^TMP($JOB,"PSSQVCS4",PSSQVLCD))
Begin DoDot:3
+29 SET PSSQVQT=1
+30 SET PSSQVDF1=$PIECE(^TMP($JOB,"PSSQVCS4",PSSQVLCD),"^")
SET PSSQVDF2=$PIECE(^TMP($JOB,"PSSQVCS4",PSSQVLCD),"^",2)
+31 SET PSSQVDF3=$$DFIND(PSSQVDF2)
IF PSSQVDF3
IF PSSQVDF1
Begin DoDot:4
+32 SET PSSQVSSS=PSSQVDF3_"^"_PSSQVDF1
End DoDot:4
End DoDot:3
KILL Y
+33 if PSSQVQT
QUIT
+34 ;
+35 ;
+36 ;Condition Set 4 (Part 2)
+37 DO CS4
+38 if PSSQVQT
QUIT
+39 ;
+40 ;
+41 ;Condition Set 1
+42 IF $PIECE($GET(PSSQVNDF),"^",4)'=""
IF $PIECE($GET(PSSQVNDF),"^",6)'=""
Begin DoDot:3
+43 IF PSSQVFZ["TAB"!(PSSQVFZ["CAP")!(PSSQVFZ="GUM,CHEWABLE")!(PSSQVFZ="IMPLANT")!(PSSQVFZ="LOZENGE")!(PSSQVFZ="SUPP,RTL")!(PSSQVFZ="TROCHE")!(PSSQVFZ="INJ/IMPLANT")
Begin DoDot:4
+44 IF $PIECE(PSSQVNDF,"^",6)="MG"!($PIECE(PSSQVNDF,"^",6)="MCG")!($PIECE(PSSQVNDF,"^",6)="UNT")!($PIECE(PSSQVNDF,"^",6)="GM")!($PIECE(PSSQVNDF,"^",6)="MEQ")
Begin DoDot:5
+45 SET PSSQVQT=1
+46 KILL PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVDF8,PSSQVMUL
+47 SET PSSQVDF4=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^")
SET PSSQVDF5=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
+48 IF PSSQVDF5
KILL X
SET X=$PIECE($GET(^PS(50.607,PSSQVDF5,0)),"^")
IF X'=""
SET PSSQVDF6=$$DFIND(X)
+49 IF '$GET(PSSQVDF6)
KILL X
SET X=$PIECE(PSSQVNDF,"^",6)
SET PSSQVDF6=$$DFIND(X)
+50 KILL Y,X
IF '$GET(PSSQVDF6)
QUIT
+51 SET PSSQVDF7=$SELECT($GET(PSSQVDF4)'="":$GET(PSSQVDF4),$PIECE(PSSQVNDF,"^",4)'="":$PIECE(PSSQVNDF,"^",4),1:"")
+52 IF PSSQVDF7'?.N&(PSSQVDF7'?.N1".".N)
KILL PSSQVDF7
+53 if $GET(PSSQVDF7)=""
QUIT
+54 SET PSSQVDF8=$$NUM^PSSDSBPA
+55 if 'PSSQVDF8
QUIT
+56 SET PSSQVMUL=PSSQVDF8*PSSQVDF7
+57 if +PSSQVMUL'=PSSQVMUL!(PSSQVMUL>99999999999999)!(PSSQVMUL<.00001)!(PSSQVMUL?.E1"."6N.N)
KILL PSSQVMUL
+58 IF '$GET(PSSQVMUL)
QUIT
+59 SET PSSQVSSS=PSSQVDF6_"^"_PSSQVMUL
End DoDot:5
End DoDot:4
End DoDot:3
+60 if $GET(PSSQVQT)
QUIT
+61 ;
+62 ;
+63 ;Condition Set 2
+64 IF $PIECE($GET(PSSQVNDF),"^",4)'=""
IF $PIECE($GET(PSSQVNDF),"^",6)'=""
Begin DoDot:3
+65 KILL PSSQV9,PSSQVFL8,PSSQVFZA
+66 SET PSSQV9=$PIECE(PSSQVNDF,"^",6)
+67 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
+68 IF PSSQVFZ="INJ"!(PSSQVFZ="INJ,SOLN")
SET PSSQVFZA=1
+69 IF $GET(PSSQVFZA)
Begin DoDot:4
+70 IF PSSQV9="GM/ML"!(PSSQV9="GM/1ML")!(PSSQV9="GM/5ML")!(PSSQV9="GM/10ML")!(PSSQV9="GM/15ML")!(PSSQV9="GM/30ML")
SET PSSQVFL8=1
+71 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")!(PSSQV9="MEQ/15ML")!(
PSSQV9="MEQ/30ML")
SET PSSQVFL8=1
+72 IF $GET(PSSQVFL8)
Begin DoDot:5
+73 SET PSSQVQT=1
+74 KILL PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVNUM,PSSQVFL9
+75 SET PSSQVXF4=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^")
SET PSSQVXF5=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
+76 IF PSSQVXF5
KILL X
SET X=$PIECE($GET(^PS(50.607,PSSQVXF5,0)),"^")
Begin DoDot:6
+77 SET PSSQVFL9=0
+78 IF X="GM/ML"!(X="GM/1ML")!(X="GM/5ML")!(X="GM/10ML")!(X="GM/15ML")!(X="GM/30ML")
SET PSSQVFL9=1
+79 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
+80 if 'PSSQVFL9
QUIT
+81 SET PSSQVXF8=$PIECE(X,"/")
SET PSSQVNUM=+$PIECE(X,"/",2)
SET PSSQVXF6=$$DFIND(PSSQVXF8)
End DoDot:6
+82 IF '$GET(PSSQVXF6)
KILL PSSQVNUM,PSSQVXF6
KILL X
SET X=PSSQV9
SET PSSQVXF9=$PIECE(X,"/")
SET PSSQVXF6=$$DFIND(PSSQVXF9)
SET PSSQVNUM=+$PIECE(PSSQV9,"/",2)
+83 IF '$GET(PSSQVXF6)
QUIT
+84 IF PSSQVNUM'=0
IF PSSQVNUM'=1
IF PSSQVNUM'=5
IF PSSQVNUM'=10
IF PSSQVNUM'=15
IF PSSQVNUM'=30
QUIT
+85 IF PSSQVNUM=0
SET PSSQVNUM=1
+86 SET PSSQVXF7=$SELECT($GET(PSSQVXF4)'="":$GET(PSSQVXF4),$PIECE(PSSQVNDF,"^",4)'="":$PIECE(PSSQVNDF,"^",4),1:"")
+87 IF PSSQVXF7'?.N&(PSSQVXF7'?.N1".".N)
KILL PSSQVXF7
+88 if $GET(PSSQVXF7)=""
QUIT
+89 IF '$DATA(^TMP($JOB,"PSSQVCS2",PSSQVLCD,PSSQVNUM))
QUIT
+90 KILL PSSQVFNX,PSSQVRSL,PSSQVFNC
+91 SET PSSQVRSL=$PIECE(^TMP($JOB,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^")
SET PSSQVFNC=$PIECE(^TMP($JOB,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^",2)
+92 IF PSSQVFNC="M"
SET PSSQVFNX=PSSQVXF7*PSSQVRSL
+93 IF PSSQVFNC="D"
SET PSSQVFNX=PSSQVXF7/PSSQVRSL
+94 if $GET(PSSQVFNX)=""
QUIT
+95 IF +PSSQVFNX'=PSSQVFNX!(PSSQVFNX>99999999999999)!(PSSQVFNX<.00001)!(PSSQVFNX?.E1"."6N.N)
QUIT
+96 SET PSSQVSSS=PSSQVXF6_"^"_PSSQVFNX
End DoDot:5
End DoDot:4
End DoDot:3
+97 if $GET(PSSQVQT)
QUIT
+98 ;
+99 ;
+100 ;Condition Set 3
+101 IF $PIECE($GET(PSSQVNDF),"^",4)'=""
IF $PIECE($GET(PSSQVNDF),"^",6)'=""
Begin DoDot:3
+102 NEW PSSQVPK1,PSSQVPK2,PSSQVPK3,PSSQVPK4,PSSQVPK5,PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
+103 SET PSSQVPK1=$PIECE(PSSQVNDF,"^",6)
+104 SET PSSQVPK3=0
FOR PSSQVPK2=1:1:$LENGTH(PSSQVPK1)
IF $EXTRACT(PSSQVPK1,PSSQVPK2)="/"
SET PSSQVPK3=PSSQVPK3+1
+105 IF PSSQVPK3=1
IF $PIECE(PSSQVPK1,"/",2)="PKT"
Begin DoDot:4
+106 SET PSSQVQT=1
+107 SET PSSQVPK4=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^")
SET PSSQVPK5=$PIECE($GET(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
+108 KILL PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
+109 IF PSSQVPK5
SET PSSQVPK6=$PIECE($GET(^PS(50.607,PSSQVPK5,0)),"^")
Begin DoDot:5
+110 SET PSSQVPK3=0
FOR PSSQVPK2=1:1:$LENGTH(PSSQVPK6)
IF $EXTRACT(PSSQVPK6,PSSQVPK2)="/"
SET PSSQVPK3=PSSQVPK3+1
+111 IF PSSQVPK3=1
IF $PIECE(PSSQVPK6,"/",2)="PKT"
SET PSSQVPK7=$PIECE(PSSQVPK6,"/")
SET PSSQVPK8=$$DFIND(PSSQVPK7)
End DoDot:5
+112 IF '$GET(PSSQVPK8)
KILL PSSQVPK8
SET PSSQVPK9=$PIECE(PSSQVPK1,"/")
SET PSSQVPK8=$$DFIND(PSSQVPK9)
+113 IF '$GET(PSSQVPK8)
QUIT
+114 SET PSSQVPKZ=$SELECT($GET(PSSQVPK4)'="":$GET(PSSQVPK4),$PIECE(PSSQVNDF,"^",4)'="":$PIECE(PSSQVNDF,"^",4),1:"")
+115 IF PSSQVPKZ'?.N&(PSSQVPKZ'?.N1".".N)
KILL PSSQVPKZ
+116 if $GET(PSSQVPKZ)=""
QUIT
+117 SET PSSQVPKB=$$NUM^PSSDSBPA
+118 if 'PSSQVPKB
QUIT
+119 SET PSSQVPKA=PSSQVPKZ*PSSQVPKB
+120 IF +PSSQVPKA'=PSSQVPKA!(PSSQVPKA>99999999999999)!(PSSQVPKA<.00001)!(PSSQVPKA?.E1"."6N.N)
QUIT
+121 SET PSSQVSSS=PSSQVPK8_"^"_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 PSSQVSSS=PSSQVF53_"^"_PSSQVF51
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+132 KILL ^TMP($JOB,"PSSQVCS2")
+133 KILL ^TMP($JOB,"PSSQVCS4")
+134 KILL ^TMP($JOB,"PSSQVCS5")
+135 QUIT PSSQVSSS
+136 ;
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 PSSQVSSS=PSSQVD11_"^"_PSSQVXXX
End DoDot:1
+9 KILL Y
+10 QUIT
+11 ;
+12 ;
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 PSSQVSSS=PSSQVCM6_"^"_PSSQVCM5
End DoDot:1
+9 KILL Y
+10 QUIT
