PSSDOSLZ.m

PSSDOSLZ ;BIR/RTR-Dosage edit ;10/24/01

 ;;1.0;PHARMACY DATA MANAGEMENT;**49**;9/30/97

 ;

 ;Reference to ^PS(50.607 supported by DBIA 2221

 ;

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(PSSIEN,"DOS")),"^")

 S PSSUNIT=$P($G(^PS(50.607,+$P($G(^PSDRUG(PSSIEN,"DOS")),"^",2),0)),"^")

 S PSSUSL=0 I PSSUNIT["/" S PSSUST=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(PSSIEN,"ND")),"^"),+$P($G(^PSDRUG(PSSIEN,"ND")),"^",3)) D  S PSSUST=+$P($G(PSSUST),"^",2) I $G(PSSUST),$G(PSSU50),+$G(PSSUST)'=+$G(PSSU50) S PSSUSL=1

 .S PSSU50=$P($G(^PSDRUG(PSSIEN,"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)

 S X=$S($E($G(PSSUNITV),1)=".":"0",1:"")_$G(PSSUNITV)

 Q

PSSDOSLZ  ;BIR/RTR-Dosage edit ;10/24/01

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**49**;9/30/97

 +2       ;

 +3       ;Reference to ^PS(50.607 supported by DBIA 2221

 +4       ;

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(PSSIEN,"DOS")),"^")

 +4        SET PSSUNIT=$PIECE($GET(^PS(50.607,+$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^",2),0)),"^")

 +5        SET PSSUSL=0

           IF PSSUNIT["/"

               SET PSSUST=$$PSJST^PSNAPIS(+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^"),+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^",3))

               Begin DoDot:1

 +6                SET PSSU50=$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")

               End DoDot:1

               SET PSSUST=+$PIECE($GET(PSSUST),"^",2)

               IF $GET(PSSUST)

                   IF $GET(PSSU50)

                       IF +$GET(PSSUST)'=+$GET(PSSU50)

                           SET PSSUSL=1

 +7        IF PSSUNIT["/"

               SET PSSUNITA=$PIECE(PSSUNIT,"/")

               SET PSSUNITB=$PIECE(PSSUNIT,"/",2)

               SET PSS1=+$GET(PSSUNITA)

               SET PSSU1=+$GET(PSSUNITB)

 +8        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))

 +9        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))

 +10       IF PSSUNIT'["/"

               SET PSSUNITV=PSSDOSEV_PSSUNIT

 +11       IF $GET(PSSUNITV)["/."

               SET PSSUZD=$GET(PSSUNITV)

               Begin DoDot:1

 +12               SET PSSUZ=$PIECE(PSSUZD,"/.")

                   SET PSSUZ1=$PIECE(PSSUZD,"/.",2)

 +13               SET PSSUNITV=$GET(PSSUZ)_"/0."_$GET(PSSUZ1)

               End DoDot:1

 +14       SET X=$SELECT($EXTRACT($GET(PSSUNITV),1)=".":"0",1:"")_$GET(PSSUNITV)

 +15       QUIT