[613] | 1 | PSSORPH1 ;BIR/RTR-Dosage by Dispense Units per Dose ;03/24/00
|
---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,49,64,69**;9/30/97
|
---|
| 3 | ;Reference to ^PS(50.607 supported by DBIA 2221
|
---|
| 4 | ;
|
---|
| 5 | S DLOOP=$G(PD)
|
---|
| 6 | Q:'$G(DLOOP)
|
---|
| 7 | ;SET PSSX(1)=-1^DDRUG IS INACTIVE OR NOT APP USE ANYMORE?
|
---|
| 8 | I $P($G(^PSDRUG(DLOOP,"I")),"^")&($P($G(^("I")),"^")'>DT) S PSSX(1)="-1^Drug is inactive" Q
|
---|
| 9 | ;I $P($G(^PSDRUG(DLOOP,2)),"^",3)'[TYPE S PSSX(1)="-1^Drug not marked for application" Q
|
---|
| 10 | S PSSTRN=$P($G(^PSDRUG(DLOOP,"DOS")),"^"),PSSUNITZ=$P($G(^("DOS")),"^",2)
|
---|
| 11 | S PSSUNITX=$S($P($G(^PS(50.607,+$G(PSSUNITZ),0)),"^")'=""&($P($G(^(0)),"^")'["/"):$P($G(^(0)),"^"),1:"")
|
---|
| 12 | S PSSDSE=+$P($G(^PS(50.7,POPD,0)),"^",2),PSSVERB=$P($G(^PS(50.606,PSSDSE,"MISC")),"^"),PSSPREP=$P($G(^("MISC")),"^",3)
|
---|
| 13 | K PSNNN F PSNN=0:0 S PSNN=$O(^PS(50.606,PSSDSE,"NOUN",PSNN)) Q:'PSNN!($D(PSNNN)) S:$P($G(^(PSNN,0)),"^")'="" PSNNN=$P($G(^(0)),"^")
|
---|
| 14 | S (PSSDOSE,PSSUNTS,PSSUDOS)=""
|
---|
| 15 | S PSSUNTS=$P($G(^PS(50.607,+$P($G(^PSDRUG(DLOOP,"DOS")),"^",2),0)),"^")
|
---|
| 16 | S PSSUDOS=$G(PSSUPD)
|
---|
| 17 | ;S PSSDOSE=PSSUDOS*+PSSTRN
|
---|
| 18 | S PSSDOSE=+$FN(PSSUDOS*+PSSTRN,"",10)
|
---|
| 19 | I $G(PSSTRN)=""!('$G(PSSUNITZ)) D SET D LEADP^PSSUTLA1 Q
|
---|
| 20 | I '$G(PSSDOSE)!('$G(PSSUDOS)) D SET D LEADP^PSSUTLA1 Q
|
---|
| 21 | S DCNT1=1
|
---|
| 22 | D PARN^PSSORPH
|
---|
| 23 | S PSSX(DCNT1)=PSSDOSE_"^"_$S("OX"[$G(TYPE):$G(PSSUNITZ),1:$G(PSSUNTS))_"^"_PSSUDOS_"^"_DLOOP_"^"_$G(PSSTRN)_"^"_$S($G(PSSNP)'="":$G(PSSNP),1:$G(PSNNN))_"^"_$P($G(^PS(50.606,+$G(PSSDSE),0)),"^")_"^"_$G(PSSVERB)_"^"_$G(PSSPREP) K PSSNP
|
---|
| 24 | S PSSA=1 D SLS^PSSORPH
|
---|
| 25 | S (PSIEN,DLOOP)=+$P(PSSX(PSSA),"^",4) K PSSMAX D:$G(TYPE)["O" MAX^PSSORPH
|
---|
| 26 | S PSSX("DD",PSIEN)=$P($G(^PSDRUG(PSIEN,0)),"^")_"^"_$P($G(^(660)),"^",6)_"^"_$P($G(^(0)),"^",9)_"^"_$P($G(^(660)),"^",8)_"^"_$P($G(^("DOS")),"^")_"^"_$G(PSSUNITX)_"^"_$G(PSSMAX)
|
---|
| 27 | D REQS^PSSORPH S PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$G(PSSREQS)_"^"_$G(PSNNN)_"^"_$G(PSSVERB)
|
---|
| 28 | D LEADP^PSSUTLA1
|
---|
| 29 | Q
|
---|
| 30 | SET ;
|
---|
| 31 | D PARN^PSSORPH
|
---|
| 32 | S PSSX(1)="^"_$S("OX"[$G(TYPE):$G(PSSUNITZ),1:$G(PSSUNTS))_"^^"_DLOOP_"^"_$G(PSSTRN)_"^"_$S($G(PSSNP)'="":$G(PSSNP),1:$G(PSNNN))_"^"_$P($G(^PS(50.606,+$G(PSSDSE),0)),"^")_"^"_$G(PSSVERB)_"^"_$G(PSSPREP) K PSSNP
|
---|
| 33 | S (PSIEN,DLOOP)=+$P(PSSX(1),"^",4) K PSSMAX D:$G(TYPE)["O" MAX^PSSORPH
|
---|
| 34 | S PSSX("DD",PSIEN)=$P($G(^PSDRUG(PSIEN,0)),"^")_"^"_$P($G(^(660)),"^",6)_"^"_$P($G(^(0)),"^",9)_"^"_$P($G(^(660)),"^",8)_"^"_$P($G(^("DOS")),"^")_"^"_$G(PSSUNITX)_"^"_$G(PSSMAX)
|
---|
| 35 | D REQS^PSSORPH S PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$G(PSSREQS)_"^"_$G(PSNNN)_"^"_$G(PSSVERB)
|
---|
| 36 | Q
|
---|
| 37 | AMP ;Replace & with AND when returning local doses to CPRS
|
---|
| 38 | N PSSAB,PSSABT,PSSABA,PSSABL,PSSABZ,PSSABX,PSSABF1,PSSABF2
|
---|
| 39 | I PSLOCV="&" S PSLOCV=" AND " Q
|
---|
| 40 | I $E(PSLOCV,1)="&" D
|
---|
| 41 | .I $E(PSLOCV,2)=" " S PSLOCV=" AND"_$E(PSLOCV,2,999) Q
|
---|
| 42 | .S PSLOCV=" AND "_$E(PSLOCV,2,999)
|
---|
| 43 | S PSSABL=$L(PSLOCV)
|
---|
| 44 | I $E(PSLOCV,PSSABL)="&" D
|
---|
| 45 | .I $E(PSLOCV,(PSSABL-1))=" " S PSLOCV=$E(PSLOCV,1,(PSSABL-1))_"AND " Q
|
---|
| 46 | .S PSLOCV=$E(PSLOCV,1,(PSSABL-1))_" AND "
|
---|
| 47 | Q:$G(PSLOCV)'["&"
|
---|
| 48 | S PSSABT=0
|
---|
| 49 | F PSSAB=1:1:$L(PSLOCV) I $E(PSLOCV,PSSAB)="&" S PSSABT=PSSABT+1
|
---|
| 50 | F PSSAB=1:1:(PSSABT+1) S PSSABA(PSSAB)=$P(PSLOCV,"&") S PSLOCV=$P(PSLOCV,"&",2,999)
|
---|
| 51 | F PSSABZ=1:1:PSSABT D
|
---|
| 52 | .K PSSABF1,PSSABF2
|
---|
| 53 | .I $L($G(PSSABA(PSSABZ)))>0 S PSSABF1=$E(PSSABA(PSSABZ),$L(PSSABA(PSSABZ)))
|
---|
| 54 | .I $D(PSSABA(PSSABZ+1)) S PSSABF2=$E(PSSABA(PSSABZ+1),1)
|
---|
| 55 | .S PSSABA(PSSABZ)=PSSABA(PSSABZ)_$S($G(PSSABF1)=" ":"AND",1:" AND")_$S($G(PSSABF2)=" ":"",1:" ")
|
---|
| 56 | K PSLOCV F PSSABX=1:1:(PSSABT+1) S PSLOCV=$G(PSLOCV)_$G(PSSABA(PSSABX))
|
---|
| 57 | Q
|
---|