Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSDSBBP

PSSDSBBP.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN(PSSQVIEN,PSSQVLCD) ;
  1.  ;PSSQVIEN = File 50 Internal Entry Number
  1.  ;PSSQVLCD = Local Possible Dosage
  1.  ;Find Dose Unit and Numeric Dose, called from PSSDSAPD
  1.  I '$G(PSSQVIEN) Q 0
  1.  I $G(PSSQVLCD)="" Q 0
  1.  D ^PSSDSBDA
  1.  N PSSQVSSS,PSSQVND1,PSSQVND3,PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVFZ,PSSQVMUL
  1.  N X,Y,DIC,DTOUT,DLAYGO,PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVQT,PSSQVDF8,PSSQV9,PSSQVNUM,PSSQVRSL,PSSQVFNC,PSSQVFNX,PSSQVNDF,PSSQVDF
  1.  N PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVFL9,PSSQVFL8,PSSQVFZA
  1.  S PSSQVSSS=0
  1.  I PSSQVIEN D
  1.  .K PSSQVND1,PSSQVND3,PSSQVDF1,PSSQVDF2,PSSQVDF3
  1.  .S PSSQVND1=$P($G(^PSDRUG(PSSQVIEN,"ND")),"^"),PSSQVND3=$P($G(^PSDRUG(PSSQVIEN,"ND")),"^",3)
  1.  .;Next line, quit if not matched to NDF, only because rest of code is relying on PSNAPIS result
  1.  .I 'PSSQVND3!('PSSQVND1) Q
  1.  .K PSSQVNDF,PSSQVDF,PSSQVFZ
  1.  .S PSSQVFZ=""
  1.  .I PSSQVND1,PSSQVND3 S PSSQVNDF=$$DFSU^PSNAPIS(PSSQVND1,PSSQVND3) S PSSQVDF=$P(PSSQVNDF,"^")
  1.  .I $G(PSSQVDF)'>0,$P($G(^PSDRUG(PSSQVIEN,2)),"^") S PSSQVDF=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSQVIEN,2)),"^"),0)),"^",2)
  1.  .I $G(PSSQVDF) S PSSQVFZ=$P($G(^PS(50.606,PSSQVDF,0)),"^")
  1.  .I 1 D
  1.  ..S PSSQVLCD=$$UP^XLFSTR(PSSQVLCD)
  1.  ..K PSSQVDF1,PSSQVDF2,PSSQVDF3,PSSQVQT
  1.  ..S PSSQVQT=0
  1.  ..;
  1.  ..;
  1.  ..;Condition Set 4 (Part 1)
  1.  ..I $D(^TMP($J,"PSSQVCS4",PSSQVLCD)) D  K Y
  1.  ...S PSSQVQT=1
  1.  ...S PSSQVDF1=$P(^TMP($J,"PSSQVCS4",PSSQVLCD),"^"),PSSQVDF2=$P(^TMP($J,"PSSQVCS4",PSSQVLCD),"^",2)
  1.  ...S PSSQVDF3=$$DFIND(PSSQVDF2) I PSSQVDF3,PSSQVDF1 D
  1.  ....S PSSQVSSS=PSSQVDF3_"^"_PSSQVDF1
  1.  ..Q:PSSQVQT
  1.  ..;
  1.  ..;
  1.  ..;Condition Set 4 (Part 2)
  1.  ..D CS4
  1.  ..Q:PSSQVQT
  1.  ..;
  1.  ..;
  1.  ..;Condition Set 1
  1.  ..I $P($G(PSSQVNDF),"^",4)'="",$P($G(PSSQVNDF),"^",6)'="" D
  1.  ...I PSSQVFZ["TAB"!(PSSQVFZ["CAP")!(PSSQVFZ="GUM,CHEWABLE")!(PSSQVFZ="IMPLANT")!(PSSQVFZ="LOZENGE")!(PSSQVFZ="SUPP,RTL")!(PSSQVFZ="TROCHE")!(PSSQVFZ="INJ/IMPLANT") D
  1.  ....I $P(PSSQVNDF,"^",6)="MG"!($P(PSSQVNDF,"^",6)="MCG")!($P(PSSQVNDF,"^",6)="UNT")!($P(PSSQVNDF,"^",6)="GM")!($P(PSSQVNDF,"^",6)="MEQ") D
  1.  .....S PSSQVQT=1
  1.  .....K PSSQVDF4,PSSQVDF5,PSSQVDF6,PSSQVDF7,PSSQVDF8,PSSQVMUL
  1.  .....S PSSQVDF4=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^"),PSSQVDF5=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
  1.  .....I PSSQVDF5 K X S X=$P($G(^PS(50.607,PSSQVDF5,0)),"^") I X'="" S PSSQVDF6=$$DFIND(X)
  1.  .....I '$G(PSSQVDF6) K X S X=$P(PSSQVNDF,"^",6) S PSSQVDF6=$$DFIND(X)
  1.  .....K Y,X I '$G(PSSQVDF6) Q
  1.  .....S PSSQVDF7=$S($G(PSSQVDF4)'="":$G(PSSQVDF4),$P(PSSQVNDF,"^",4)'="":$P(PSSQVNDF,"^",4),1:"")
  1.  .....I PSSQVDF7'?.N&(PSSQVDF7'?.N1".".N) K PSSQVDF7
  1.  .....Q:$G(PSSQVDF7)=""
  1.  .....S PSSQVDF8=$$NUM^PSSDSBPA
  1.  .....Q:'PSSQVDF8
  1.  .....S PSSQVMUL=PSSQVDF8*PSSQVDF7
  1.  .....K:+PSSQVMUL'=PSSQVMUL!(PSSQVMUL>99999999999999)!(PSSQVMUL<.00001)!(PSSQVMUL?.E1"."6N.N) PSSQVMUL
  1.  .....I '$G(PSSQVMUL) Q
  1.  .....S PSSQVSSS=PSSQVDF6_"^"_PSSQVMUL
  1.  ..Q:$G(PSSQVQT)
  1.  ..;
  1.  ..;
  1.  ..;Condition Set 2
  1.  ..I $P($G(PSSQVNDF),"^",4)'="",$P($G(PSSQVNDF),"^",6)'="" D
  1.  ...K PSSQV9,PSSQVFL8,PSSQVFZA
  1.  ...S PSSQV9=$P(PSSQVNDF,"^",6)
  1.  ...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
  1.  ...I PSSQVFZ="INJ"!(PSSQVFZ="INJ,SOLN") S PSSQVFZA=1
  1.  ...I $G(PSSQVFZA) D
  1.  ....I PSSQV9="GM/ML"!(PSSQV9="GM/1ML")!(PSSQV9="GM/5ML")!(PSSQV9="GM/10ML")!(PSSQV9="GM/15ML")!(PSSQV9="GM/30ML") S PSSQVFL8=1
  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
  1.  ....I $G(PSSQVFL8) D
  1.  .....S PSSQVQT=1
  1.  .....K PSSQVXF4,PSSQVXF5,PSSQVXF6,PSSQVXF7,PSSQVXF8,PSSQVXF9,PSSQVNUM,PSSQVFL9
  1.  .....S PSSQVXF4=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^"),PSSQVXF5=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
  1.  .....I PSSQVXF5 K X S X=$P($G(^PS(50.607,PSSQVXF5,0)),"^") D
  1.  ......S PSSQVFL9=0
  1.  ......I X="GM/ML"!(X="GM/1ML")!(X="GM/5ML")!(X="GM/10ML")!(X="GM/15ML")!(X="GM/30ML") S PSSQVFL9=1
  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
  1.  ......Q:'PSSQVFL9
  1.  ......S PSSQVXF8=$P(X,"/") S PSSQVNUM=+$P(X,"/",2) S PSSQVXF6=$$DFIND(PSSQVXF8)
  1.  .....I '$G(PSSQVXF6) K PSSQVNUM,PSSQVXF6 K X S X=PSSQV9 S PSSQVXF9=$P(X,"/") S PSSQVXF6=$$DFIND(PSSQVXF9) S PSSQVNUM=+$P(PSSQV9,"/",2)
  1.  .....I '$G(PSSQVXF6) Q
  1.  .....I PSSQVNUM'=0,PSSQVNUM'=1,PSSQVNUM'=5,PSSQVNUM'=10,PSSQVNUM'=15,PSSQVNUM'=30 Q
  1.  .....I PSSQVNUM=0 S PSSQVNUM=1
  1.  .....S PSSQVXF7=$S($G(PSSQVXF4)'="":$G(PSSQVXF4),$P(PSSQVNDF,"^",4)'="":$P(PSSQVNDF,"^",4),1:"")
  1.  .....I PSSQVXF7'?.N&(PSSQVXF7'?.N1".".N) K PSSQVXF7
  1.  .....Q:$G(PSSQVXF7)=""
  1.  .....I '$D(^TMP($J,"PSSQVCS2",PSSQVLCD,PSSQVNUM)) Q
  1.  .....K PSSQVFNX,PSSQVRSL,PSSQVFNC
  1.  .....S PSSQVRSL=$P(^TMP($J,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^"),PSSQVFNC=$P(^TMP($J,"PSSQVCS2",PSSQVLCD,PSSQVNUM),"^",2)
  1.  .....I PSSQVFNC="M" S PSSQVFNX=PSSQVXF7*PSSQVRSL
  1.  .....I PSSQVFNC="D" S PSSQVFNX=PSSQVXF7/PSSQVRSL
  1.  .....Q:$G(PSSQVFNX)=""
  1.  .....I +PSSQVFNX'=PSSQVFNX!(PSSQVFNX>99999999999999)!(PSSQVFNX<.00001)!(PSSQVFNX?.E1"."6N.N) Q
  1.  .....S PSSQVSSS=PSSQVXF6_"^"_PSSQVFNX
  1.  ..Q:$G(PSSQVQT)
  1.  ..;
  1.  ..;
  1.  ..;Condition Set 3
  1.  ..I $P($G(PSSQVNDF),"^",4)'="",$P($G(PSSQVNDF),"^",6)'="" D
  1.  ...N PSSQVPK1,PSSQVPK2,PSSQVPK3,PSSQVPK4,PSSQVPK5,PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
  1.  ...S PSSQVPK1=$P(PSSQVNDF,"^",6)
  1.  ...S PSSQVPK3=0 F PSSQVPK2=1:1:$L(PSSQVPK1) I $E(PSSQVPK1,PSSQVPK2)="/" S PSSQVPK3=PSSQVPK3+1
  1.  ...I PSSQVPK3=1,$P(PSSQVPK1,"/",2)="PKT" D
  1.  ....S PSSQVQT=1
  1.  ....S PSSQVPK4=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^"),PSSQVPK5=$P($G(^PSDRUG(PSSQVIEN,"DOS")),"^",2)
  1.  ....K PSSQVPK6,PSSQVPK7,PSSQVPK8,PSSQVPK9,PSSQVPKZ,PSSQVPKA,PSSQVPKB
  1.  ....I PSSQVPK5 S PSSQVPK6=$P($G(^PS(50.607,PSSQVPK5,0)),"^") D
  1.  .....S PSSQVPK3=0 F PSSQVPK2=1:1:$L(PSSQVPK6) I $E(PSSQVPK6,PSSQVPK2)="/" S PSSQVPK3=PSSQVPK3+1
  1.  .....I PSSQVPK3=1,$P(PSSQVPK6,"/",2)="PKT" S PSSQVPK7=$P(PSSQVPK6,"/") S PSSQVPK8=$$DFIND(PSSQVPK7)
  1.  ....I '$G(PSSQVPK8) K PSSQVPK8 S PSSQVPK9=$P(PSSQVPK1,"/") S PSSQVPK8=$$DFIND(PSSQVPK9)
  1.  ....I '$G(PSSQVPK8) Q
  1.  ....S PSSQVPKZ=$S($G(PSSQVPK4)'="":$G(PSSQVPK4),$P(PSSQVNDF,"^",4)'="":$P(PSSQVNDF,"^",4),1:"")
  1.  ....I PSSQVPKZ'?.N&(PSSQVPKZ'?.N1".".N) K PSSQVPKZ
  1.  ....Q:$G(PSSQVPKZ)=""
  1.  ....S PSSQVPKB=$$NUM^PSSDSBPA
  1.  ....Q:'PSSQVPKB
  1.  ....S PSSQVPKA=PSSQVPKZ*PSSQVPKB
  1.  ....I +PSSQVPKA'=PSSQVPKA!(PSSQVPKA>99999999999999)!(PSSQVPKA<.00001)!(PSSQVPKA?.E1"."6N.N) Q
  1.  ....S PSSQVSSS=PSSQVPK8_"^"_PSSQVPKA
  1.  ..Q:$G(PSSQVQT)
  1.  ..;
  1.  ..;
  1.  ..;Condition set 5
  1.  ..I PSSQVND1,PSSQVND3,$P($G(PSSQVNDF),"^",4)="",$P($G(PSSQVNDF),"^",6)="" D
  1.  ...I $D(^TMP($J,"PSSQVCS5",PSSQVLCD)) D
  1.  ....N PSSQVF51,PSSQVF52,PSSQVF53
  1.  ....S PSSQVF51=$P(^TMP($J,"PSSQVCS5",PSSQVLCD),"^"),PSSQVF52=$P(^TMP($J,"PSSQVCS5",PSSQVLCD),"^",2)
  1.  ....S PSSQVF53=$$DFIND(PSSQVF52) I PSSQVF51,PSSQVF53 D
  1.  .....S PSSQVSSS=PSSQVF53_"^"_PSSQVF51
  1.  K ^TMP($J,"PSSQVCS2")
  1.  K ^TMP($J,"PSSQVCS4")
  1.  K ^TMP($J,"PSSQVCS5")
  1.  Q PSSQVSSS
  1.  ;
  1. CS4 ;
  1.  I PSSQVLCD?.N1" UNITS" D CS4ST Q
  1.  I PSSQVLCD?.N1" UNIT" D CS4ST Q
  1.  I PSSQVLCD?.N1" UNIT(S)" D CS4ST Q
  1.  I PSSQVLCD?.N1" UNT" D CS4ST Q
  1.  I PSSQVLCD?.N1" UNT(S)" D CS4ST Q
  1.  I PSSQVLCD?.N1" UNTS" D CS4ST Q
  1.  I PSSQVLCD?.N1".".N1" UNITS" D CS4ST Q
  1.  I PSSQVLCD?.N1".".N1" UNIT" D CS4ST Q
  1.  I PSSQVLCD?.N1".".N1" UNIT(S)" D CS4ST Q
  1.  I PSSQVLCD?.N1".".N1" UNT" D CS4ST Q
  1.  I PSSQVLCD?.N1".".N1" UNT(S)" D CS4ST Q
  1.  I PSSQVLCD?.N1".".N1" UNTS" D CS4ST Q
  1.  D COMMA
  1.  Q
  1.  ;
  1. CS4ST ;
  1.  S PSSQVQT=1
  1.  N PSSQVXXX,PSSQVD11,PSSQVD12
  1.  S PSSQVXXX=+PSSQVLCD
  1.  K:+PSSQVXXX'=PSSQVXXX!(PSSQVXXX>99999999999999)!(PSSQVXXX<.00001)!(PSSQVXXX?.E1"."6N.N) PSSQVXXX
  1.  I '$G(PSSQVXXX) Q
  1.  S PSSQVD12="UNIT(S)"
  1.  S PSSQVD11=$$DFIND(PSSQVD12) I PSSQVD11 D
  1.  .S PSSQVSSS=PSSQVD11_"^"_PSSQVXXX
  1.  K Y
  1.  Q
  1.  ;
  1.  ;
  1. DFIND(PSSQVFND) ;Fine IEN, can't do DIC Lookup because of exact match check
  1.  N PSSQVFN1
  1.  S PSSQVFN1=$O(^PS(51.24,"B",PSSQVFND,0)) I PSSQVFN1,'$$SCREEN^XTID(51.24,.01,PSSQVFN1_",") Q PSSQVFN1
  1.  S PSSQVFN1=$O(^PS(51.24,"C",PSSQVFND,0)) I PSSQVFN1,'$$SCREEN^XTID(51.24,.01,PSSQVFN1_",") Q PSSQVFN1
  1.  S PSSQVFN1=$O(^PS(51.24,"D",PSSQVFND,0)) I PSSQVFN1,'$$SCREEN^XTID(51.24,.01,PSSQVFN1_",") Q PSSQVFN1
  1.  Q 0
  1.  ;
  1. COMMA ;
  1.  N PSSQVCM1,PSSQVCM2,PSSQVCM3,PSSQVCM4
  1.  I PSSQVLCD'[" " Q
  1.  S PSSQVCM1=$P(PSSQVLCD," ")
  1.  S PSSQVCM3=$F(PSSQVLCD," ")
  1.  S PSSQVCM2=$TR(PSSQVCM1,",","")
  1.  S PSSQVCM4=PSSQVCM2_$E(PSSQVLCD,(PSSQVCM3-1),$L(PSSQVLCD))
  1.  I PSSQVCM4?.N1" UNITS" D CS4ST1 Q
  1.  I PSSQVCM4?.N1" UNIT" D CS4ST1 Q
  1.  I PSSQVCM4?.N1" UNIT(S)" D CS4ST1 Q
  1.  I PSSQVCM4?.N1" UNT" D CS4ST1 Q
  1.  I PSSQVCM4?.N1" UNT(S)" D CS4ST1 Q
  1.  I PSSQVCM4?.N1" UNTS" D CS4ST1 Q
  1.  Q
  1.  ;
  1. CS4ST1 ;
  1.  S PSSQVQT=1
  1.  N PSSQVCM5,PSSQVCM6,PSSQVCM7
  1.  S PSSQVCM5=+PSSQVCM4
  1.  K:+PSSQVCM5'=PSSQVCM5!(PSSQVCM5>99999999999999)!(PSSQVCM5<.00001)!(PSSQVCM5?.E1"."6N.N) PSSQVCM5
  1.  I '$G(PSSQVCM5) Q
  1.  S PSSQVCM7="UNIT(S)"
  1.  S PSSQVCM6=$$DFIND(PSSQVCM7) I PSSQVCM6 D
  1.  .S PSSQVSSS=PSSQVCM6_"^"_PSSQVCM5
  1.  K Y
  1.  Q