- PSSHRQ25 ;BIR/RTR-Create General Dosing Guidelines ;04/25/17
- ;;1.0;PHARMACY DATA MANAGEMENT;**178**;9/30/97;Build 14
- ;External reference to $$SCREEN^XTID supported by DBIA 4631
- ;
- BUILDMSG(COUNT,HASH) ; Build General Dosing Guidelines
- ;
- ; COUNT = Counter used to access values in hash
- ; HASH = Variable containing drug dose values
- ;
- ; Returns Message in format:
- ; General dosing range for '[DRUG NAME]' [ROUTE DESCRIPTION]:
- ; low dose (unit) to high dose (unit).
- ; Maximum daily dose is (max daily dose).
- ;
- N PSSGXMSG,PSSGXDFT,PSSGX1,PSSGX2,PSSGX3,PSSGX4,PSSGX8,PSSGXDU,PSSHXA
- S PSSGXDFT=$P(^TMP($J,BASE,"IN","DOSE",HASH(COUNT,"orderNumber")),U,14)
- S PSSGXDU=$P(^TMP($J,BASE,"IN","DOSE",HASH(COUNT,"orderNumber")),U,6)
- ;
- ;Non-Dose Form Unit
- I 'PSSGXDFT D Q PSSGXMSG
- .D CNV(0),INTRO S PSSGX1=PSSHXA("doseLow")
- .S PSSGX2=PSSHXA("doseHigh")
- .I $E(PSSGX1)="." S PSSGX1=0_PSSGX1
- .I $E(PSSGX2)="." S PSSGX2=0_PSSGX2
- .S PSSGXMSG=PSSGXMSG_" "_PSSGX1_" "_PSSHXA("doseLowUnit") D
- ..I PSSGX1=PSSGX2 S PSSGXMSG=PSSGXMSG_"." Q
- ..S PSSGXMSG=PSSGXMSG_" to "_PSSGX2_" "_PSSHXA("doseHighUnit")_"."
- .S PSSGX3=PSSHXA("maxDailyDose"),PSSGX8=0
- .I PSSGX3=" **unknown** "!('PSSGX3)!(PSSHXA("maxDailyDoseUnit")=" **unknown** ") S PSSGX3="unavailable.",PSSGX8=1
- .S PSSGX4=$$CONRT() I $E(PSSGX3)="." S PSSGX3=0_PSSGX3
- .S PSSGXMSG=PSSGXMSG_$S(PSSGX4:" Maximum dose rate is ",1:" Maximum daily dose is ")_$S(PSSGX8:PSSGX3,1:PSSGX3_" "_PSSHXA("maxDailyDoseUnit")_".")
- ;
- ;Dose Form Unit
- D CNV(1),INTRO S PSSGX1=PSSHXA("doseFormLow")
- S PSSGX2=PSSHXA("doseFormHigh")
- I $E(PSSGX1)="." S PSSGX1=0_PSSGX1
- I $E(PSSGX2)="." S PSSGX2=0_PSSGX2
- S PSSGXMSG=PSSGXMSG_" "_PSSGX1_" "_PSSHXA("doseFormLowUnit") D
- .I PSSGX1=PSSGX2 S PSSGXMSG=PSSGXMSG_"." Q
- .S PSSGXMSG=PSSGXMSG_" to "_PSSGX2_" "_PSSHXA("doseFormHighUnit")_"."
- S PSSGX3=PSSHXA("maxDailyDoseForm"),PSSGX8=0
- I PSSGX3=" **unknown** "!('PSSGX3)!(PSSHXA("maxDailyDoseFormUnit")=" **unknown** ") S PSSGX3="unavailable.",PSSGX8=1
- S PSSGX4=$$CONRT() I $E(PSSGX3)="." S PSSGX3=0_PSSGX3
- S PSSGXMSG=PSSGXMSG_$S(PSSGX4:" Maximum dose rate is ",1:" Maximum daily dose is ")_$S(PSSGX8:PSSGX3,1:PSSGX3_" "_PSSHXA("maxDailyDoseFormUnit")_".")
- Q PSSGXMSG
- ;
- ;
- CASE(PSSLWR) ;Translate to uppercase
- Q $$UP^XLFSTR(PSSLWR)
- ;
- ;
- CONRT() ;Look for continuous route
- N PSSGX9
- S PSSGX9=$P(^TMP($J,BASE,"IN","DOSE",HASH(COUNT,"orderNumber")),U,11)
- I PSSGX9="CONTINUOUS EPIDURAL" Q 1
- I PSSGX9="CONT INTRAARTER INF" Q 1
- I PSSGX9="CONTINUOUS INFILTRAT" Q 1
- I PSSGX9="CONT CAUDAL INFUSION" Q 1
- I PSSGX9="CONT INTRAOSSEOUS" Q 1
- I PSSGX9="CONT INTRATHECAL INF" Q 1
- I PSSGX9="CONTINUOUS INFUSION" Q 1
- I PSSGX9="CONT NEBULIZATION" Q 1
- I PSSGX9="CONT SUBCUTAN INFUSI" Q 1
- Q 0
- ;
- ;
- INTRO ;Start message
- S PSSGXMSG="General dosing range for "_PSSHXA("drugName")
- I $G(HASH(COUNT,"doseRouteDescription"))'="" S PSSGXMSG=PSSGXMSG_" ("_HASH(COUNT,"doseRouteDescription")_")"
- S PSSGXMSG=PSSGXMSG_":"
- Q
- ;
- ;
- CNV(PSSHXTYP) ;Reset display array and convert Dose Units if necessary
- N PSSHX4,PSSHX5,PSSHX6,PSSHX8,PSSHX9,PSSHXL,PSSHXFL,PSSHXNM,PSSHXIEN,PSSHXNUL,PSSHXMCH,PSSHXOLD,PSSUNARA,PSSUNARF,PSSHXFND
- S (PSSHXFL,PSSHXNUL,PSSHXIEN)=0
- I PSSGXDU'="" S PSSHXIEN=$O(^PS(51.24,"C",PSSGXDU,0)) I PSSHXIEN D SUNIT(.PSSUNARA,PSSHXIEN)
- I PSSHXTYP D DFT1
- I 'PSSHXTYP F PSSHXL="doseLowUnit","doseHighUnit","maxDailyDoseUnit" D
- .S (PSSHXA(PSSHXL),PSSHX5)=$G(HASH(COUNT,PSSHXL)) I PSSHX5="" S PSSHXA(PSSHXL)=" **unknown** " S:PSSHXL["dose" PSSHXNUL=1 Q
- .I PSSHXIEN D FDUNIT(PSSHX5)
- I PSSHXIEN S PSSHXNM=$P($G(^PS(51.24,PSSHXIEN,0)),"^") S:PSSHXNM="" PSSHXFL=0
- D @$S(PSSHXTYP:"DFT3",1:"CONDU") ;reset remaining variables
- I PSSGXDU=""!('PSSHXFL)!(PSSHXNUL)!('PSSHXIEN) Q
- ;
- ;Find mismatched Unit and set array of values
- S PSSHXL="" F S PSSHXL=$O(PSSHXMCH("MISMATCH",PSSHXL)) Q:'PSSHXFL!(PSSHXL="") D
- .K PSSUNARF D
- ..S PSSHX9=PSSHXA(PSSHXL)
- ..S PSSHX9=$$CASE(PSSHX9)
- ..S PSSHX8=$$LKUN(PSSHX9) I PSSHX8 D SUNIT(.PSSUNARF,PSSHX8) Q
- ..I PSSHX9'[" " S PSSHXFL=0 Q
- ..S PSSHX9=$P(PSSHX9," ") I PSSHX9="" S PSSHXFL=0 Q
- ..S PSSHX8=$$LKUN(PSSHX9) I PSSHX8 D SUNIT(.PSSUNARF,PSSHX8),PRS Q
- ..S PSSHXFL=0
- .Q:'PSSHXFL
- .S PSSHXFND=0,PSSHX6="" F S PSSHX6=$O(PSSUNARF(PSSHX6)) Q:PSSHX6=""!(PSSHXFND) D
- ..I $$FNCV(PSSHX6) S PSSHXFND=1
- .I 'PSSHXFND S PSSHXFL=0
- Q:'PSSHXFL
- ;
- ;Set each unit name to Dose Unit name, and convert numeric values
- I PSSHXTYP D Q
- .F PSSHXL="doseFormLowUnit","doseFormHighUnit","maxDailyDoseFormUnit" D
- ..S PSSHXA(PSSHXL)=PSSHXNM S:$D(PSSHXNM(PSSHXL)) PSSHXA(PSSHXL)=PSSHXA(PSSHXL)_PSSHXNM(PSSHXL)
- ..I $D(PSSHXMCH("MISMATCH",PSSHXL)) D
- ...S PSSHXOLD=$S(PSSHXL="doseFormLowUnit":"doseFormLow",PSSHXL="doseFormHighUnit":"doseFormHigh",1:"maxDailyDoseForm")
- ...S PSSHXA(PSSHXOLD)=PSSHXA(PSSHXOLD)*PSSHX4(PSSHXL)
- ...S PSSHXA(PSSHXOLD)=$$FMTNUM^PSSDSUTA(PSSHXA(PSSHXOLD),1)
- F PSSHXL="doseLowUnit","doseHighUnit","maxDailyDoseUnit" D
- .S PSSHXA(PSSHXL)=PSSHXNM S:$D(PSSHXNM(PSSHXL)) PSSHXA(PSSHXL)=PSSHXA(PSSHXL)_PSSHXNM(PSSHXL)
- .I $D(PSSHXMCH("MISMATCH",PSSHXL)) D
- ..S PSSHXOLD=$S(PSSHXL="doseLowUnit":"doseLow",PSSHXL="doseHighUnit":"doseHigh",1:"maxDailyDose")
- ..S PSSHXA(PSSHXOLD)=PSSHXA(PSSHXOLD)*PSSHX4(PSSHXL)
- ..S PSSHXA(PSSHXOLD)=$$FMTNUM^PSSDSUTA(PSSHXA(PSSHXOLD),1)
- Q
- ;
- ;
- LKUN(PSSLUNV) ;Look for Unit
- N PSSLNUNI
- S PSSLNUNI=$O(^PS(51.24,"B",PSSLUNV,0)) I PSSLNUNI,'$$SCREEN^XTID(51.24,.01,PSSLNUNI_",") Q PSSLNUNI
- S PSSLNUNI=$O(^PS(51.24,"C",PSSLUNV,0)) I PSSLNUNI,'$$SCREEN^XTID(51.24,.01,PSSLNUNI_",") Q PSSLNUNI
- S PSSLNUNI=$O(^PS(51.24,"D",PSSLUNV,0)) I PSSLNUNI,'$$SCREEN^XTID(51.24,.01,PSSLNUNI_",") Q PSSLNUNI
- Q 0
- ;
- ;
- SUNIT(PSSUNARG,PSSUNARR) ;Set Unit arrays
- N PSSUNARN,PSSUNARL
- S PSSUNARN=$$CASE($G(^PS(51.24,PSSUNARR,0)))
- S:$P(PSSUNARN,"^")'="" PSSUNARG($P(PSSUNARN,"^"))=""
- S:$P(PSSUNARN,"^",2)'="" PSSUNARG($P(PSSUNARN,"^",2))=""
- S PSSUNARL="" F S PSSUNARL=$O(^PS(51.24,PSSUNARR,1,"B",PSSUNARL)) Q:PSSUNARL="" S PSSUNARG($$CASE(PSSUNARL))=""
- Q
- ;
- ;
- PRS ;Look for any verbage to add to Name using 'per' as the key
- N PSSPER1,PSSPER2
- S PSSPER1=$$CASE(PSSHXA(PSSHXL))
- Q:PSSPER1'[" PER "
- S PSSPER2=$F(PSSPER1," PER ")
- S PSSPER2=PSSPER2-5
- S PSSHXNM(PSSHXL)=$E(PSSHXA(PSSHXL),PSSPER2,$L(PSSPER1))
- Q
- ;
- ;
- FNCV(PSSLUNFN) ;Find conversion value
- N PSSHX2,PSSHX3,PSSHXQ,PSSHXCV1,PSSHXCV2
- S (PSSHX3,PSSHXQ)=0
- S PSSHX2=$O(^PS(51.25,"B",PSSLUNFN,0)) I PSSHX2 D
- .S PSSHX3="" F S PSSHX3=$O(^PS(51.25,PSSHX2,1,"B",PSSHX3)) Q:PSSHX3=""!(PSSHXQ) D
- ..I '$D(PSSUNARA(PSSHX3)) Q
- ..S PSSHXCV1=$O(^PS(51.25,PSSHX2,1,"B",PSSHX3,0)) Q:'PSSHXCV1
- ..S PSSHXCV2=$P($G(^PS(51.25,PSSHX2,1,PSSHXCV1,0)),"^",2) Q:'PSSHXCV2
- ..S PSSHX4(PSSHXL)=PSSHXCV2,PSSHXQ=1
- Q PSSHXQ
- ;
- ;
- FDUNIT(PSSKQ1) ;Determine match from Order Unit to FDB units
- ;Set PSSHXFL TO 1 if at least one mismatch, and set PSSHXMCH array
- N PSSKQ2
- S PSSKQ2=$$CASE(PSSKQ1)
- I $D(PSSUNARA(PSSKQ2)) S PSSHXMCH("MATCH",PSSHXL)="" Q
- I PSSKQ2'[" " D FDSET Q
- S PSSKQ2=$P(PSSKQ2," ") I PSSKQ2="" D FDSET Q
- I $D(PSSUNARA(PSSKQ2)) S PSSHXMCH("MATCH",PSSHXL)="" Q
- D FDSET
- Q
- FDSET ;
- S PSSHXMCH("MISMATCH",PSSHXL)="",PSSHXFL=1
- Q
- ;
- ;
- CONDU ;Convert last three Non-Dose Form values, no conversion of data
- F PSSHXL="doseLow","doseHigh","maxDailyDose","drugName" D
- .S PSSHXA(PSSHXL)=$G(HASH(COUNT,PSSHXL)) I PSSHXA(PSSHXL)="" S PSSHXA(PSSHXL)=" **unknown** " S:PSSHXL["dose" PSSHXNUL=1
- Q
- ;
- ;
- DFT1 ;Initialize variables for Dose Form Type
- F PSSHXL="doseFormLowUnit","doseFormHighUnit","maxDailyDoseFormUnit" D
- .S (PSSHXA(PSSHXL),PSSHX5)=$G(HASH(COUNT,PSSHXL)) I PSSHX5="" S PSSHXA(PSSHXL)=" **unknown** " S:PSSHXL["dose" PSSHXNUL=1 Q
- .I PSSHXIEN D FDUNIT(PSSHX5)
- Q
- ;
- ;
- DFT3 ;Convert last three Dose Form values, no conversion of data
- F PSSHXL="doseFormLow","doseFormHigh","maxDailyDoseForm","drugName" D
- .S PSSHXA(PSSHXL)=$G(HASH(COUNT,PSSHXL)) I PSSHXA(PSSHXL)="" S PSSHXA(PSSHXL)=" **unknown** " S:PSSHXL["dose" PSSHXNUL=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRQ25 8079 printed Mar 13, 2025@21:36:26 Page 2
- PSSHRQ25 ;BIR/RTR-Create General Dosing Guidelines ;04/25/17
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**178**;9/30/97;Build 14
- +2 ;External reference to $$SCREEN^XTID supported by DBIA 4631
- +3 ;
- BUILDMSG(COUNT,HASH) ; Build General Dosing Guidelines
- +1 ;
- +2 ; COUNT = Counter used to access values in hash
- +3 ; HASH = Variable containing drug dose values
- +4 ;
- +5 ; Returns Message in format:
- +6 ; General dosing range for '[DRUG NAME]' [ROUTE DESCRIPTION]:
- +7 ; low dose (unit) to high dose (unit).
- +8 ; Maximum daily dose is (max daily dose).
- +9 ;
- +10 NEW PSSGXMSG,PSSGXDFT,PSSGX1,PSSGX2,PSSGX3,PSSGX4,PSSGX8,PSSGXDU,PSSHXA
- +11 SET PSSGXDFT=$PIECE(^TMP($JOB,BASE,"IN","DOSE",HASH(COUNT,"orderNumber")),U,14)
- +12 SET PSSGXDU=$PIECE(^TMP($JOB,BASE,"IN","DOSE",HASH(COUNT,"orderNumber")),U,6)
- +13 ;
- +14 ;Non-Dose Form Unit
- +15 IF 'PSSGXDFT
- Begin DoDot:1
- +16 DO CNV(0)
- DO INTRO
- SET PSSGX1=PSSHXA("doseLow")
- +17 SET PSSGX2=PSSHXA("doseHigh")
- +18 IF $EXTRACT(PSSGX1)="."
- SET PSSGX1=0_PSSGX1
- +19 IF $EXTRACT(PSSGX2)="."
- SET PSSGX2=0_PSSGX2
- +20 SET PSSGXMSG=PSSGXMSG_" "_PSSGX1_" "_PSSHXA("doseLowUnit")
- Begin DoDot:2
- +21 IF PSSGX1=PSSGX2
- SET PSSGXMSG=PSSGXMSG_"."
- QUIT
- +22 SET PSSGXMSG=PSSGXMSG_" to "_PSSGX2_" "_PSSHXA("doseHighUnit")_"."
- End DoDot:2
- +23 SET PSSGX3=PSSHXA("maxDailyDose")
- SET PSSGX8=0
- +24 IF PSSGX3=" **unknown** "!('PSSGX3)!(PSSHXA("maxDailyDoseUnit")=" **unknown** ")
- SET PSSGX3="unavailable."
- SET PSSGX8=1
- +25 SET PSSGX4=$$CONRT()
- IF $EXTRACT(PSSGX3)="."
- SET PSSGX3=0_PSSGX3
- +26 SET PSSGXMSG=PSSGXMSG_$SELECT(PSSGX4:" Maximum dose rate is ",1:" Maximum daily dose is ")_$SELECT(PSSGX8:PSSGX3,1:PSSGX3_" "_PSSHXA("maxDailyDoseUnit")_".")
- End DoDot:1
- QUIT PSSGXMSG
- +27 ;
- +28 ;Dose Form Unit
- +29 DO CNV(1)
- DO INTRO
- SET PSSGX1=PSSHXA("doseFormLow")
- +30 SET PSSGX2=PSSHXA("doseFormHigh")
- +31 IF $EXTRACT(PSSGX1)="."
- SET PSSGX1=0_PSSGX1
- +32 IF $EXTRACT(PSSGX2)="."
- SET PSSGX2=0_PSSGX2
- +33 SET PSSGXMSG=PSSGXMSG_" "_PSSGX1_" "_PSSHXA("doseFormLowUnit")
- Begin DoDot:1
- +34 IF PSSGX1=PSSGX2
- SET PSSGXMSG=PSSGXMSG_"."
- QUIT
- +35 SET PSSGXMSG=PSSGXMSG_" to "_PSSGX2_" "_PSSHXA("doseFormHighUnit")_"."
- End DoDot:1
- +36 SET PSSGX3=PSSHXA("maxDailyDoseForm")
- SET PSSGX8=0
- +37 IF PSSGX3=" **unknown** "!('PSSGX3)!(PSSHXA("maxDailyDoseFormUnit")=" **unknown** ")
- SET PSSGX3="unavailable."
- SET PSSGX8=1
- +38 SET PSSGX4=$$CONRT()
- IF $EXTRACT(PSSGX3)="."
- SET PSSGX3=0_PSSGX3
- +39 SET PSSGXMSG=PSSGXMSG_$SELECT(PSSGX4:" Maximum dose rate is ",1:" Maximum daily dose is ")_$SELECT(PSSGX8:PSSGX3,1:PSSGX3_" "_PSSHXA("maxDailyDoseFormUnit")_".")
- +40 QUIT PSSGXMSG
- +41 ;
- +42 ;
- CASE(PSSLWR) ;Translate to uppercase
- +1 QUIT $$UP^XLFSTR(PSSLWR)
- +2 ;
- +3 ;
- CONRT() ;Look for continuous route
- +1 NEW PSSGX9
- +2 SET PSSGX9=$PIECE(^TMP($JOB,BASE,"IN","DOSE",HASH(COUNT,"orderNumber")),U,11)
- +3 IF PSSGX9="CONTINUOUS EPIDURAL"
- QUIT 1
- +4 IF PSSGX9="CONT INTRAARTER INF"
- QUIT 1
- +5 IF PSSGX9="CONTINUOUS INFILTRAT"
- QUIT 1
- +6 IF PSSGX9="CONT CAUDAL INFUSION"
- QUIT 1
- +7 IF PSSGX9="CONT INTRAOSSEOUS"
- QUIT 1
- +8 IF PSSGX9="CONT INTRATHECAL INF"
- QUIT 1
- +9 IF PSSGX9="CONTINUOUS INFUSION"
- QUIT 1
- +10 IF PSSGX9="CONT NEBULIZATION"
- QUIT 1
- +11 IF PSSGX9="CONT SUBCUTAN INFUSI"
- QUIT 1
- +12 QUIT 0
- +13 ;
- +14 ;
- INTRO ;Start message
- +1 SET PSSGXMSG="General dosing range for "_PSSHXA("drugName")
- +2 IF $GET(HASH(COUNT,"doseRouteDescription"))'=""
- SET PSSGXMSG=PSSGXMSG_" ("_HASH(COUNT,"doseRouteDescription")_")"
- +3 SET PSSGXMSG=PSSGXMSG_":"
- +4 QUIT
- +5 ;
- +6 ;
- CNV(PSSHXTYP) ;Reset display array and convert Dose Units if necessary
- +1 NEW PSSHX4,PSSHX5,PSSHX6,PSSHX8,PSSHX9,PSSHXL,PSSHXFL,PSSHXNM,PSSHXIEN,PSSHXNUL,PSSHXMCH,PSSHXOLD,PSSUNARA,PSSUNARF,PSSHXFND
- +2 SET (PSSHXFL,PSSHXNUL,PSSHXIEN)=0
- +3 IF PSSGXDU'=""
- SET PSSHXIEN=$ORDER(^PS(51.24,"C",PSSGXDU,0))
- IF PSSHXIEN
- DO SUNIT(.PSSUNARA,PSSHXIEN)
- +4 IF PSSHXTYP
- DO DFT1
- +5 IF 'PSSHXTYP
- FOR PSSHXL="doseLowUnit","doseHighUnit","maxDailyDoseUnit"
- Begin DoDot:1
- +6 SET (PSSHXA(PSSHXL),PSSHX5)=$GET(HASH(COUNT,PSSHXL))
- IF PSSHX5=""
- SET PSSHXA(PSSHXL)=" **unknown** "
- if PSSHXL["dose"
- SET PSSHXNUL=1
- QUIT
- +7 IF PSSHXIEN
- DO FDUNIT(PSSHX5)
- End DoDot:1
- +8 IF PSSHXIEN
- SET PSSHXNM=$PIECE($GET(^PS(51.24,PSSHXIEN,0)),"^")
- if PSSHXNM=""
- SET PSSHXFL=0
- +9 ;reset remaining variables
- DO @$SELECT(PSSHXTYP:"DFT3",1:"CONDU")
- +10 IF PSSGXDU=""!('PSSHXFL)!(PSSHXNUL)!('PSSHXIEN)
- QUIT
- +11 ;
- +12 ;Find mismatched Unit and set array of values
- +13 SET PSSHXL=""
- FOR
- SET PSSHXL=$ORDER(PSSHXMCH("MISMATCH",PSSHXL))
- if 'PSSHXFL!(PSSHXL="")
- QUIT
- Begin DoDot:1
- +14 KILL PSSUNARF
- Begin DoDot:2
- +15 SET PSSHX9=PSSHXA(PSSHXL)
- +16 SET PSSHX9=$$CASE(PSSHX9)
- +17 SET PSSHX8=$$LKUN(PSSHX9)
- IF PSSHX8
- DO SUNIT(.PSSUNARF,PSSHX8)
- QUIT
- +18 IF PSSHX9'[" "
- SET PSSHXFL=0
- QUIT
- +19 SET PSSHX9=$PIECE(PSSHX9," ")
- IF PSSHX9=""
- SET PSSHXFL=0
- QUIT
- +20 SET PSSHX8=$$LKUN(PSSHX9)
- IF PSSHX8
- DO SUNIT(.PSSUNARF,PSSHX8)
- DO PRS
- QUIT
- +21 SET PSSHXFL=0
- End DoDot:2
- +22 if 'PSSHXFL
- QUIT
- +23 SET PSSHXFND=0
- SET PSSHX6=""
- FOR
- SET PSSHX6=$ORDER(PSSUNARF(PSSHX6))
- if PSSHX6=""!(PSSHXFND)
- QUIT
- Begin DoDot:2
- +24 IF $$FNCV(PSSHX6)
- SET PSSHXFND=1
- End DoDot:2
- +25 IF 'PSSHXFND
- SET PSSHXFL=0
- End DoDot:1
- +26 if 'PSSHXFL
- QUIT
- +27 ;
- +28 ;Set each unit name to Dose Unit name, and convert numeric values
- +29 IF PSSHXTYP
- Begin DoDot:1
- +30 FOR PSSHXL="doseFormLowUnit","doseFormHighUnit","maxDailyDoseFormUnit"
- Begin DoDot:2
- +31 SET PSSHXA(PSSHXL)=PSSHXNM
- if $DATA(PSSHXNM(PSSHXL))
- SET PSSHXA(PSSHXL)=PSSHXA(PSSHXL)_PSSHXNM(PSSHXL)
- +32 IF $DATA(PSSHXMCH("MISMATCH",PSSHXL))
- Begin DoDot:3
- +33 SET PSSHXOLD=$SELECT(PSSHXL="doseFormLowUnit":"doseFormLow",PSSHXL="doseFormHighUnit":"doseFormHigh",1:"maxDailyDoseForm")
- +34 SET PSSHXA(PSSHXOLD)=PSSHXA(PSSHXOLD)*PSSHX4(PSSHXL)
- +35 SET PSSHXA(PSSHXOLD)=$$FMTNUM^PSSDSUTA(PSSHXA(PSSHXOLD),1)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +36 FOR PSSHXL="doseLowUnit","doseHighUnit","maxDailyDoseUnit"
- Begin DoDot:1
- +37 SET PSSHXA(PSSHXL)=PSSHXNM
- if $DATA(PSSHXNM(PSSHXL))
- SET PSSHXA(PSSHXL)=PSSHXA(PSSHXL)_PSSHXNM(PSSHXL)
- +38 IF $DATA(PSSHXMCH("MISMATCH",PSSHXL))
- Begin DoDot:2
- +39 SET PSSHXOLD=$SELECT(PSSHXL="doseLowUnit":"doseLow",PSSHXL="doseHighUnit":"doseHigh",1:"maxDailyDose")
- +40 SET PSSHXA(PSSHXOLD)=PSSHXA(PSSHXOLD)*PSSHX4(PSSHXL)
- +41 SET PSSHXA(PSSHXOLD)=$$FMTNUM^PSSDSUTA(PSSHXA(PSSHXOLD),1)
- End DoDot:2
- End DoDot:1
- +42 QUIT
- +43 ;
- +44 ;
- LKUN(PSSLUNV) ;Look for Unit
- +1 NEW PSSLNUNI
- +2 SET PSSLNUNI=$ORDER(^PS(51.24,"B",PSSLUNV,0))
- IF PSSLNUNI
- IF '$$SCREEN^XTID(51.24,.01,PSSLNUNI_",")
- QUIT PSSLNUNI
- +3 SET PSSLNUNI=$ORDER(^PS(51.24,"C",PSSLUNV,0))
- IF PSSLNUNI
- IF '$$SCREEN^XTID(51.24,.01,PSSLNUNI_",")
- QUIT PSSLNUNI
- +4 SET PSSLNUNI=$ORDER(^PS(51.24,"D",PSSLUNV,0))
- IF PSSLNUNI
- IF '$$SCREEN^XTID(51.24,.01,PSSLNUNI_",")
- QUIT PSSLNUNI
- +5 QUIT 0
- +6 ;
- +7 ;
- SUNIT(PSSUNARG,PSSUNARR) ;Set Unit arrays
- +1 NEW PSSUNARN,PSSUNARL
- +2 SET PSSUNARN=$$CASE($GET(^PS(51.24,PSSUNARR,0)))
- +3 if $PIECE(PSSUNARN,"^")'=""
- SET PSSUNARG($PIECE(PSSUNARN,"^"))=""
- +4 if $PIECE(PSSUNARN,"^",2)'=""
- SET PSSUNARG($PIECE(PSSUNARN,"^",2))=""
- +5 SET PSSUNARL=""
- FOR
- SET PSSUNARL=$ORDER(^PS(51.24,PSSUNARR,1,"B",PSSUNARL))
- if PSSUNARL=""
- QUIT
- SET PSSUNARG($$CASE(PSSUNARL))=""
- +6 QUIT
- +7 ;
- +8 ;
- PRS ;Look for any verbage to add to Name using 'per' as the key
- +1 NEW PSSPER1,PSSPER2
- +2 SET PSSPER1=$$CASE(PSSHXA(PSSHXL))
- +3 if PSSPER1'[" PER "
- QUIT
- +4 SET PSSPER2=$FIND(PSSPER1," PER ")
- +5 SET PSSPER2=PSSPER2-5
- +6 SET PSSHXNM(PSSHXL)=$EXTRACT(PSSHXA(PSSHXL),PSSPER2,$LENGTH(PSSPER1))
- +7 QUIT
- +8 ;
- +9 ;
- FNCV(PSSLUNFN) ;Find conversion value
- +1 NEW PSSHX2,PSSHX3,PSSHXQ,PSSHXCV1,PSSHXCV2
- +2 SET (PSSHX3,PSSHXQ)=0
- +3 SET PSSHX2=$ORDER(^PS(51.25,"B",PSSLUNFN,0))
- IF PSSHX2
- Begin DoDot:1
- +4 SET PSSHX3=""
- FOR
- SET PSSHX3=$ORDER(^PS(51.25,PSSHX2,1,"B",PSSHX3))
- if PSSHX3=""!(PSSHXQ)
- QUIT
- Begin DoDot:2
- +5 IF '$DATA(PSSUNARA(PSSHX3))
- QUIT
- +6 SET PSSHXCV1=$ORDER(^PS(51.25,PSSHX2,1,"B",PSSHX3,0))
- if 'PSSHXCV1
- QUIT
- +7 SET PSSHXCV2=$PIECE($GET(^PS(51.25,PSSHX2,1,PSSHXCV1,0)),"^",2)
- if 'PSSHXCV2
- QUIT
- +8 SET PSSHX4(PSSHXL)=PSSHXCV2
- SET PSSHXQ=1
- End DoDot:2
- End DoDot:1
- +9 QUIT PSSHXQ
- +10 ;
- +11 ;
- FDUNIT(PSSKQ1) ;Determine match from Order Unit to FDB units
- +1 ;Set PSSHXFL TO 1 if at least one mismatch, and set PSSHXMCH array
- +2 NEW PSSKQ2
- +3 SET PSSKQ2=$$CASE(PSSKQ1)
- +4 IF $DATA(PSSUNARA(PSSKQ2))
- SET PSSHXMCH("MATCH",PSSHXL)=""
- QUIT
- +5 IF PSSKQ2'[" "
- DO FDSET
- QUIT
- +6 SET PSSKQ2=$PIECE(PSSKQ2," ")
- IF PSSKQ2=""
- DO FDSET
- QUIT
- +7 IF $DATA(PSSUNARA(PSSKQ2))
- SET PSSHXMCH("MATCH",PSSHXL)=""
- QUIT
- +8 DO FDSET
- +9 QUIT
- FDSET ;
- +1 SET PSSHXMCH("MISMATCH",PSSHXL)=""
- SET PSSHXFL=1
- +2 QUIT
- +3 ;
- +4 ;
- CONDU ;Convert last three Non-Dose Form values, no conversion of data
- +1 FOR PSSHXL="doseLow","doseHigh","maxDailyDose","drugName"
- Begin DoDot:1
- +2 SET PSSHXA(PSSHXL)=$GET(HASH(COUNT,PSSHXL))
- IF PSSHXA(PSSHXL)=""
- SET PSSHXA(PSSHXL)=" **unknown** "
- if PSSHXL["dose"
- SET PSSHXNUL=1
- End DoDot:1
- +3 QUIT
- +4 ;
- +5 ;
- DFT1 ;Initialize variables for Dose Form Type
- +1 FOR PSSHXL="doseFormLowUnit","doseFormHighUnit","maxDailyDoseFormUnit"
- Begin DoDot:1
- +2 SET (PSSHXA(PSSHXL),PSSHX5)=$GET(HASH(COUNT,PSSHXL))
- IF PSSHX5=""
- SET PSSHXA(PSSHXL)=" **unknown** "
- if PSSHXL["dose"
- SET PSSHXNUL=1
- QUIT
- +3 IF PSSHXIEN
- DO FDUNIT(PSSHX5)
- End DoDot:1
- +4 QUIT
- +5 ;
- +6 ;
- DFT3 ;Convert last three Dose Form values, no conversion of data
- +1 FOR PSSHXL="doseFormLow","doseFormHigh","maxDailyDoseForm","drugName"
- Begin DoDot:1
- +2 SET PSSHXA(PSSHXL)=$GET(HASH(COUNT,PSSHXL))
- IF PSSHXA(PSSHXL)=""
- SET PSSHXA(PSSHXL)=" **unknown** "
- if PSSHXL["dose"
- SET PSSHXNUL=1
- End DoDot:1
- +3 QUIT
