- 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 Mar 13, 2025@21:35:24 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
