PSSDOSED ;BIR/RTR-Dosage edit ;03/09/00
;;1.0;PHARMACY DATA MANAGEMENT;**34,38,49,50**;9/30/97
;Reference to ^PS(50.607 supported by DBIA #2221
;
W ! K DIC S DIC="^PSDRUG(",DIC(0)="QEAMZ",DIC("A")="Select Drug: " D ^DIC K DIC I +Y<1!($D(DTOUT)) Q
Q
SET ;x-ref on Dispense Unit per Dose to set Dose field
N PSSUNIT,PSSUNITV,PSSDOSEV,PSS2,PSS1,PSS3,PSSU1,PSSUNITA,PSSUNITB,PSSUSL,PSSUST,PSSU50,PSSUSL2,PSSUSL3,PSSUSL4,PSSUSL5
N PSSUZ,PSSUZ1,PSSUZD
S PSSDOSEV=+$G(X)*+$P($G(^PSDRUG(DA(1),"DOS")),"^")
S $P(^PSDRUG(DA(1),"DOS1",DA,0),"^",2)=PSSDOSEV
S PSSUNIT=$P($G(^PS(50.607,+$P($G(^PSDRUG(DA(1),"DOS")),"^",2),0)),"^")
S PSSUSL=0 I PSSUNIT["/" S PSSHLDDA=$G(DA),PSSHLDX=$G(X) S PSSUST=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(DA(1),"ND")),"^"),+$P($G(^PSDRUG(DA(1),"ND")),"^",3)) D S PSSUST=+$P($G(PSSUST),"^",2) I $G(PSSUST),$G(PSSU50),+$G(PSSUST)'=+$G(PSSU50) S PSSUSL=1
.S DA=$G(PSSHLDDA),X=$G(PSSHLDX) K PSSHLDDA,PSSHLDX
.S PSSU50=$P($G(^PSDRUG(DA(1),"DOS")),"^")
I PSSUNIT["/" S PSSUNITA=$P(PSSUNIT,"/"),PSSUNITB=$P(PSSUNIT,"/",2),PSS1=+$G(PSSUNITA),PSSU1=+$G(PSSUNITB)
I PSSUNIT["/",$G(PSSUSL) S PSSUSL2=PSSU50/PSSUST,PSSUSL3=PSSUSL2*X S PSSUSL4=PSSUSL3*$S($G(PSSU1):PSSU1,1:1) S PSSUSL5=$S('$G(PSSU1):PSSUSL4_$G(PSSUNITB),1:PSSUSL4_$P(PSSUNITB,PSSU1,2))
I PSSUNIT["/" S PSSUNITV=$S('$G(PSS1):PSSDOSEV,1:($G(PSS1)*PSSDOSEV))_$S($G(PSS1):$P(PSSUNITA,PSS1,2),1:PSSUNITA)_"/"_$S($G(PSSUSL):$G(PSSUSL5),'$G(PSSU1):X_PSSUNITB,1:(X*+PSSU1)_$P(PSSUNITB,PSSU1,2))
I PSSUNIT'["/" S PSSUNITV=PSSDOSEV_PSSUNIT
I $G(PSSUNITV)["/." S PSSUZD=$G(PSSUNITV) D
.S PSSUZ=$P(PSSUZD,"/."),PSSUZ1=$P(PSSUZD,"/.",2)
.S PSSUNITV=$G(PSSUZ)_"/0."_$G(PSSUZ1)
D EN^DDIOL(" Dosage = "_$S($E($G(PSSUNITV),1)=".":"0",1:"")_$G(PSSUNITV))
Q
KILL ;
S $P(^PSDRUG(DA(1),"DOS1",DA,0),"^",2)=""
Q
SETS ;Set cross reference on Strength
N PSS4,PSS5,PSS6,PSS7,PSS8,PSS9,PSSUNA1,PSSUNB1,PSSUA1,PSSUB1,PSSNDS,PSSLASH,PSSLASH1,PSSLASH2,PSSLASH3,PSSLASH4,PSSLASH5
N PSSSZ,PSSSZ1,PSSSZD
D EN^DDIOL(" ")
D EN^DDIOL("Resetting possible dosages:")
F PSS4=0:0 S PSS4=$O(^PSDRUG(DA,"DOS1",PSS4)) Q:'PSS4 S PSS5=+$P($G(^PSDRUG(DA,"DOS1",PSS4,0)),"^") D:PSS5
.S PSS6=+$G(X)*+$G(PSS5)
.S $P(^PSDRUG(DA,"DOS1",PSS4,0),"^",2)=PSS6
.S PSS7=$P($G(^PS(50.607,+$P($G(^PSDRUG(DA,"DOS")),"^",2),0)),"^")
.S PSSLASH=0 I PSS7["/" S PSSHLDDA=$G(DA),PSSHLDX=$G(X) S PSSNDS=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(DA,"ND")),"^"),+$P($G(^PSDRUG(DA,"ND")),"^",3)) D S PSSNDS=+$P($G(PSSNDS),"^",2) I $G(PSSNDS),$G(X),+$G(PSSNDS)'=+$G(X) S PSSLASH=1
..S DA=$G(PSSHLDDA),X=$G(PSSHLDX) K PSSHLDDA,PSSHLDX
.I PSS7["/" S PSSUNA1=$P(PSS7,"/"),PSSUNB1=$P(PSS7,"/",2),PSSUA1=+$G(PSSUNA1),PSSUB1=+$G(PSSUNB1)
.I PSS7["/",$G(PSSLASH) S PSSLASH2=X/PSSNDS,PSSLASH3=PSSLASH2*PSS5 S PSSLASH4=PSSLASH3*$S($G(PSSUB1):PSSUB1,1:1) S PSSLASH5=$S('$G(PSSUB1):PSSLASH4_$G(PSSUNB1),1:PSSLASH4_$P(PSSUNB1,PSSUB1,2))
.I PSS7["/" S PSS9=$S('$G(PSSUA1):PSS6,1:($G(PSSUA1)*PSS6))_$S($G(PSSUA1):$P(PSSUNA1,PSSUA1,2),1:PSSUNA1)_"/"_$S($G(PSSLASH):$G(PSSLASH5),'$G(PSSUB1):PSS5_$G(PSSUNB1),1:(PSS5*+PSSUB1)_$P(PSSUNB1,PSSUB1,2))
.I PSS7'["/" S PSS9=PSS6_PSS7
.I $G(PSS9)["/." S PSSSZD=$G(PSS9) D
..S PSSSZ=$P(PSSSZD,"/."),PSSSZ1=$P(PSSSZD,"/.",2)
..S PSS9=$G(PSSSZ)_"/0."_$G(PSSSZ1)
.D EN^DDIOL(" Possible Dosage = "_$S($E($G(PSS9),1)=".":"0",1:"")_$G(PSS9))
Q
KILLS ;Kill cross reference on Strength
N PSS10
F PSS10=0:0 S PSS10=$O(^PSDRUG(DA,"DOS1",PSS10)) Q:'PSS10 S $P(^PSDRUG(DA,"DOS1",PSS10,0),"^",2)=""
Q
IO ;Input Transform for Package field in Possible Dose multiple
S X=$$UP^XLFSTR(X) I (X'?1"I")&(X'?1"O")&(X'?1"IO")&(X'?1"OI") K X Q
S PSS12=$P($G(^PSDRUG(DA(1),"ND")),"^",3),PSS121=$P($G(^("ND")),"^") S PSSSAVEX=$G(X)
S PSSSAVDA=$G(DA),PSSSAVD1=$G(DA(1))
S PSSIOVAR="" I PSS12,PSS121 S PSSIOVAR=$$DFSU^PSNAPIS(PSS121,PSS12)
S X=PSSSAVEX,DA=PSSSAVDA,DA(1)=PSSSAVD1
S PSS13=$S($P($G(^PSDRUG(DA(1),"DOS")),"^",2):$P($G(^("DOS")),"^",2),1:+$P(PSSIOVAR,"^",5)),PSS14=+$P(PSSIOVAR,"^")
I X["I",'$D(^PS(50.606,"ACONI",+$G(PSS14),+$G(PSS13))) D K X D IOK Q
.D EN^DDIOL("Unit/Dosage Form combination cannot be converted for Inpatient Medications")
I X["O",'$D(^PS(50.606,"ACONO",+$G(PSS14),+$G(PSS13))) D K X D IOK Q
.D EN^DDIOL("Unit/Dosage Form combination cannot be converted for Outpatient Pharmacy")
D IOK
Q
IOK ;
K PSS12,PSS13,PSSSAVEX,PSSIOVAR,PSSSAVDA,PSSSAVD1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDOSED 4395 printed Dec 13, 2024@02:30:56 Page 2
PSSDOSED ;BIR/RTR-Dosage edit ;03/09/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,49,50**;9/30/97
+2 ;Reference to ^PS(50.607 supported by DBIA #2221
+3 ;
+4 WRITE !
KILL DIC
SET DIC="^PSDRUG("
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Drug: "
DO ^DIC
KILL DIC
IF +Y<1!($DATA(DTOUT))
QUIT
+5 QUIT
SET ;x-ref on Dispense Unit per Dose to set Dose field
+1 NEW PSSUNIT,PSSUNITV,PSSDOSEV,PSS2,PSS1,PSS3,PSSU1,PSSUNITA,PSSUNITB,PSSUSL,PSSUST,PSSU50,PSSUSL2,PSSUSL3,PSSUSL4,PSSUSL5
+2 NEW PSSUZ,PSSUZ1,PSSUZD
+3 SET PSSDOSEV=+$GET(X)*+$PIECE($GET(^PSDRUG(DA(1),"DOS")),"^")
+4 SET $PIECE(^PSDRUG(DA(1),"DOS1",DA,0),"^",2)=PSSDOSEV
+5 SET PSSUNIT=$PIECE($GET(^PS(50.607,+$PIECE($GET(^PSDRUG(DA(1),"DOS")),"^",2),0)),"^")
+6 SET PSSUSL=0
IF PSSUNIT["/"
SET PSSHLDDA=$GET(DA)
SET PSSHLDX=$GET(X)
SET PSSUST=$$PSJST^PSNAPIS(+$PIECE($GET(^PSDRUG(DA(1),"ND")),"^"),+$PIECE($GET(^PSDRUG(DA(1),"ND")),"^",3))
Begin DoDot:1
+7 SET DA=$GET(PSSHLDDA)
SET X=$GET(PSSHLDX)
KILL PSSHLDDA,PSSHLDX
+8 SET PSSU50=$PIECE($GET(^PSDRUG(DA(1),"DOS")),"^")
End DoDot:1
SET PSSUST=+$PIECE($GET(PSSUST),"^",2)
IF $GET(PSSUST)
IF $GET(PSSU50)
IF +$GET(PSSUST)'=+$GET(PSSU50)
SET PSSUSL=1
+9 IF PSSUNIT["/"
SET PSSUNITA=$PIECE(PSSUNIT,"/")
SET PSSUNITB=$PIECE(PSSUNIT,"/",2)
SET PSS1=+$GET(PSSUNITA)
SET PSSU1=+$GET(PSSUNITB)
+10 IF PSSUNIT["/"
IF $GET(PSSUSL)
SET PSSUSL2=PSSU50/PSSUST
SET PSSUSL3=PSSUSL2*X
SET PSSUSL4=PSSUSL3*$SELECT($GET(PSSU1):PSSU1,1:1)
SET PSSUSL5=$SELECT('$GET(PSSU1):PSSUSL4_$GET(PSSUNITB),1:PSSUSL4_$PIECE(PSSUNITB,PSSU1,2))
+11 IF PSSUNIT["/"
SET PSSUNITV=$SELECT('$GET(PSS1):PSSDOSEV,1:($GET(PSS1)*PSSDOSEV))_$SELECT($GET(PSS1):$PIECE(PSSUNITA,PSS1,2),1:PSSUNITA)_"/"_$SELECT($GET(PSSUSL):$GET(PSSUSL5),'$GET(PSSU1):X_PSSUNITB,1:(X*+PSSU1)_$PIECE(PSSUNITB,PSSU1,2))
+12 IF PSSUNIT'["/"
SET PSSUNITV=PSSDOSEV_PSSUNIT
+13 IF $GET(PSSUNITV)["/."
SET PSSUZD=$GET(PSSUNITV)
Begin DoDot:1
+14 SET PSSUZ=$PIECE(PSSUZD,"/.")
SET PSSUZ1=$PIECE(PSSUZD,"/.",2)
+15 SET PSSUNITV=$GET(PSSUZ)_"/0."_$GET(PSSUZ1)
End DoDot:1
+16 DO EN^DDIOL(" Dosage = "_$SELECT($EXTRACT($GET(PSSUNITV),1)=".":"0",1:"")_$GET(PSSUNITV))
+17 QUIT
KILL ;
+1 SET $PIECE(^PSDRUG(DA(1),"DOS1",DA,0),"^",2)=""
+2 QUIT
SETS ;Set cross reference on Strength
+1 NEW PSS4,PSS5,PSS6,PSS7,PSS8,PSS9,PSSUNA1,PSSUNB1,PSSUA1,PSSUB1,PSSNDS,PSSLASH,PSSLASH1,PSSLASH2,PSSLASH3,PSSLASH4,PSSLASH5
+2 NEW PSSSZ,PSSSZ1,PSSSZD
+3 DO EN^DDIOL(" ")
+4 DO EN^DDIOL("Resetting possible dosages:")
+5 FOR PSS4=0:0
SET PSS4=$ORDER(^PSDRUG(DA,"DOS1",PSS4))
if 'PSS4
QUIT
SET PSS5=+$PIECE($GET(^PSDRUG(DA,"DOS1",PSS4,0)),"^")
if PSS5
Begin DoDot:1
+6 SET PSS6=+$GET(X)*+$GET(PSS5)
+7 SET $PIECE(^PSDRUG(DA,"DOS1",PSS4,0),"^",2)=PSS6
+8 SET PSS7=$PIECE($GET(^PS(50.607,+$PIECE($GET(^PSDRUG(DA,"DOS")),"^",2),0)),"^")
+9 SET PSSLASH=0
IF PSS7["/"
SET PSSHLDDA=$GET(DA)
SET PSSHLDX=$GET(X)
SET PSSNDS=$$PSJST^PSNAPIS(+$PIECE($GET(^PSDRUG(DA,"ND")),"^"),+$PIECE($GET(^PSDRUG(DA,"ND")),"^",3))
Begin DoDot:2
+10 SET DA=$GET(PSSHLDDA)
SET X=$GET(PSSHLDX)
KILL PSSHLDDA,PSSHLDX
End DoDot:2
SET PSSNDS=+$PIECE($GET(PSSNDS),"^",2)
IF $GET(PSSNDS)
IF $GET(X)
IF +$GET(PSSNDS)'=+$GET(X)
SET PSSLASH=1
+11 IF PSS7["/"
SET PSSUNA1=$PIECE(PSS7,"/")
SET PSSUNB1=$PIECE(PSS7,"/",2)
SET PSSUA1=+$GET(PSSUNA1)
SET PSSUB1=+$GET(PSSUNB1)
+12 IF PSS7["/"
IF $GET(PSSLASH)
SET PSSLASH2=X/PSSNDS
SET PSSLASH3=PSSLASH2*PSS5
SET PSSLASH4=PSSLASH3*$SELECT($GET(PSSUB1):PSSUB1,1:1)
SET PSSLASH5=$SELECT('$GET(PSSUB1):PSSLASH4_$GET(PSSUNB1),1:PSSLASH4_$PIECE(PSSUNB1,PSSUB1,2))
+13 IF PSS7["/"
SET PSS9=$SELECT('$GET(PSSUA1):PSS6,1:($GET(PSSUA1)*PSS6))_$SELECT($GET(PSSUA1):$PIECE(PSSUNA1,PSSUA1,2),1:PSSUNA1)_"/"_$SELECT($GET(PSSLASH):$GET(PSSLASH5),'$GET(PSSUB1):PSS5_$GET(PSSUNB1),1:(PSS5*+PSSUB1)_$PIECE(PSSUNB1,PSSUB1
,2))
+14 IF PSS7'["/"
SET PSS9=PSS6_PSS7
+15 IF $GET(PSS9)["/."
SET PSSSZD=$GET(PSS9)
Begin DoDot:2
+16 SET PSSSZ=$PIECE(PSSSZD,"/.")
SET PSSSZ1=$PIECE(PSSSZD,"/.",2)
+17 SET PSS9=$GET(PSSSZ)_"/0."_$GET(PSSSZ1)
End DoDot:2
+18 DO EN^DDIOL(" Possible Dosage = "_$SELECT($EXTRACT($GET(PSS9),1)=".":"0",1:"")_$GET(PSS9))
End DoDot:1
+19 QUIT
KILLS ;Kill cross reference on Strength
+1 NEW PSS10
+2 FOR PSS10=0:0
SET PSS10=$ORDER(^PSDRUG(DA,"DOS1",PSS10))
if 'PSS10
QUIT
SET $PIECE(^PSDRUG(DA,"DOS1",PSS10,0),"^",2)=""
+3 QUIT
IO ;Input Transform for Package field in Possible Dose multiple
+1 SET X=$$UP^XLFSTR(X)
IF (X'?1"I")&(X'?1"O")&(X'?1"IO")&(X'?1"OI")
KILL X
QUIT
+2 SET PSS12=$PIECE($GET(^PSDRUG(DA(1),"ND")),"^",3)
SET PSS121=$PIECE($GET(^("ND")),"^")
SET PSSSAVEX=$GET(X)
+3 SET PSSSAVDA=$GET(DA)
SET PSSSAVD1=$GET(DA(1))
+4 SET PSSIOVAR=""
IF PSS12
IF PSS121
SET PSSIOVAR=$$DFSU^PSNAPIS(PSS121,PSS12)
+5 SET X=PSSSAVEX
SET DA=PSSSAVDA
SET DA(1)=PSSSAVD1
+6 SET PSS13=$SELECT($PIECE($GET(^PSDRUG(DA(1),"DOS")),"^",2):$PIECE($GET(^("DOS")),"^",2),1:+$PIECE(PSSIOVAR,"^",5))
SET PSS14=+$PIECE(PSSIOVAR,"^")
+7 IF X["I"
IF '$DATA(^PS(50.606,"ACONI",+$GET(PSS14),+$GET(PSS13)))
Begin DoDot:1
+8 DO EN^DDIOL("Unit/Dosage Form combination cannot be converted for Inpatient Medications")
End DoDot:1
KILL X
DO IOK
QUIT
+9 IF X["O"
IF '$DATA(^PS(50.606,"ACONO",+$GET(PSS14),+$GET(PSS13)))
Begin DoDot:1
+10 DO EN^DDIOL("Unit/Dosage Form combination cannot be converted for Outpatient Pharmacy")
End DoDot:1
KILL X
DO IOK
QUIT
+11 DO IOK
+12 QUIT
IOK ;
+1 KILL PSS12,PSS13,PSSSAVEX,PSSIOVAR,PSSSAVDA,PSSSAVD1
+2 QUIT
