| [613] | 1 | PSSORPHZ ;BIR/RTR-Dosage by Dispense Units for report ;03/24/00
 | 
|---|
 | 2 |  ;;1.0;PHARMACY DATA MANAGEMENT;**40**;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 |  I $G(PSSTRN)=""!('$G(PSSUNITZ)) D SET D LEAD^PSSORPH Q
 | 
|---|
 | 19 |  I '$G(PSSDOSE)!('$G(PSSUDOS)) D SET D LEAD^PSSORPH Q
 | 
|---|
 | 20 |  S DCNT1=1
 | 
|---|
 | 21 |  D PARN^PSSORPH
 | 
|---|
 | 22 |  S PSSX(DCNT1)=PSSDOSE_"^"_$S($G(TYPE)="O":$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
 | 
|---|
 | 23 |  S PSSA=1 D SLS^PSSORPH
 | 
|---|
 | 24 |  S (PSIEN,DLOOP)=+$P(PSSX(PSSA),"^",4) K PSSMAX D:$G(TYPE)["O" MAX^PSSORPH
 | 
|---|
 | 25 |  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)
 | 
|---|
 | 26 |  D REQS^PSSORPH S PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$G(PSSREQS)_"^"_$G(PSNNN)_"^"_$G(PSSVERB)
 | 
|---|
 | 27 |  D LEAD^PSSORPH
 | 
|---|
 | 28 |  Q
 | 
|---|
 | 29 | SET ;
 | 
|---|
 | 30 |  D PARN^PSSORPH
 | 
|---|
 | 31 |  S PSSX(1)="^"_$S($G(TYPE)="O":$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
 | 
|---|
 | 32 |  S (PSIEN,DLOOP)=+$P(PSSX(1),"^",4) K PSSMAX D:$G(TYPE)["O" MAX^PSSORPH
 | 
|---|
 | 33 |  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)
 | 
|---|
 | 34 |  D REQS^PSSORPH S PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$G(PSSREQS)_"^"_$G(PSNNN)_"^"_$G(PSSVERB)
 | 
|---|
 | 35 |  Q
 | 
|---|
 | 36 | AMP ;Replace & with AND when returning local doses to CPRS
 | 
|---|
 | 37 |  N PSSAB,PSSABT,PSSABA,PSSABL,PSSABZ,PSSABX,PSSABF1,PSSABF2
 | 
|---|
 | 38 |  I PSLOCV="&" S PSLOCV=" AND " Q
 | 
|---|
 | 39 |  I $E(PSLOCV,1)="&" D
 | 
|---|
 | 40 |  .I $E(PSLOCV,2)=" " S PSLOCV=" AND"_$E(PSLOCV,2,999) Q
 | 
|---|
 | 41 |  .S PSLOCV=" AND "_$E(PSLOCV,2,999)
 | 
|---|
 | 42 |  S PSSABL=$L(PSLOCV)
 | 
|---|
 | 43 |  I $E(PSLOCV,PSSABL)="&" D
 | 
|---|
 | 44 |  .I $E(PSLOCV,(PSSABL-1))=" " S PSLOCV=$E(PSLOCV,1,(PSSABL-1))_"AND " Q
 | 
|---|
 | 45 |  .S PSLOCV=$E(PSLOCV,1,(PSSABL-1))_" AND "
 | 
|---|
 | 46 |  Q:$G(PSLOCV)'["&"
 | 
|---|
 | 47 |  S PSSABT=0
 | 
|---|
 | 48 |  F PSSAB=1:1:$L(PSLOCV) I $E(PSLOCV,PSSAB)="&" S PSSABT=PSSABT+1
 | 
|---|
 | 49 |  F PSSAB=1:1:(PSSABT+1) S PSSABA(PSSAB)=$P(PSLOCV,"&") S PSLOCV=$P(PSLOCV,"&",2,999)
 | 
|---|
 | 50 |  F PSSABZ=1:1:PSSABT D
 | 
|---|
 | 51 |  .K PSSABF1,PSSABF2
 | 
|---|
 | 52 |  .I $L($G(PSSABA(PSSABZ)))>0 S PSSABF1=$E(PSSABA(PSSABZ),$L(PSSABA(PSSABZ)))
 | 
|---|
 | 53 |  .I $D(PSSABA(PSSABZ+1)) S PSSABF2=$E(PSSABA(PSSABZ+1),1)
 | 
|---|
 | 54 |  .S PSSABA(PSSABZ)=PSSABA(PSSABZ)_$S($G(PSSABF1)=" ":"AND",1:" AND")_$S($G(PSSABF2)=" ":"",1:" ")
 | 
|---|
 | 55 |  K PSLOCV F PSSABX=1:1:(PSSABT+1) S PSLOCV=$G(PSLOCV)_$G(PSSABA(PSSABX))
 | 
|---|
 | 56 |  Q
 | 
|---|