- PSSORPH1 ;BIR/RTR-Dosage by Dispense Units per Dose ;03/24/00
- ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,49,64,69,138**;9/30/97;Build 5
- ;Reference to ^PS(50.607 supported by DBIA 2221
- ;
- S DLOOP=$G(PD)
- Q:'$G(DLOOP)
- ;SET PSSX(1)=-1^DDRUG IS INACTIVE OR NOT APP USE ANYMORE?
- I $P($G(^PSDRUG(DLOOP,"I")),"^")&($P($G(^("I")),"^")'>DT) S PSSX(1)="-1^Drug is inactive" Q
- ;I $P($G(^PSDRUG(DLOOP,2)),"^",3)'[TYPE S PSSX(1)="-1^Drug not marked for application" Q
- S PSSTRN=$P($G(^PSDRUG(DLOOP,"DOS")),"^"),PSSUNITZ=$P($G(^("DOS")),"^",2)
- S PSSUNITX=$S($P($G(^PS(50.607,+$G(PSSUNITZ),0)),"^")'=""&($P($G(^(0)),"^")'["/"):$P($G(^(0)),"^"),1:"")
- S PSSDSE=+$P($G(^PS(50.7,POPD,0)),"^",2),PSSVERB=$P($G(^PS(50.606,PSSDSE,"MISC")),"^"),PSSPREP=$P($G(^("MISC")),"^",3)
- 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)),"^")
- S (PSSDOSE,PSSUNTS,PSSUDOS)=""
- S PSSUNTS=$P($G(^PS(50.607,+$P($G(^PSDRUG(DLOOP,"DOS")),"^",2),0)),"^")
- S PSSUDOS=$G(PSSUPD)
- ;S PSSDOSE=PSSUDOS*+PSSTRN
- S PSSDOSE=+$FN(PSSUDOS*+PSSTRN,"",10)
- I $G(PSSTRN)=""!('$G(PSSUNITZ)) D SET D LEADP^PSSUTLA1 Q
- I '$G(PSSDOSE)!('$G(PSSUDOS)) D SET D LEADP^PSSUTLA1 Q
- S DCNT1=1
- D PARN^PSSORPH
- 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
- S PSSA=1 D SLS^PSSORPH
- S (PSIEN,DLOOP)=+$P(PSSX(PSSA),"^",4) K PSSMAX D:$G(TYPE)["O" MAX^PSSORPH
- 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)
- D REQS^PSSORPH S PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$G(PSSREQS)_"^"_$G(PSNNN)_"^"_$G(PSSVERB)
- D LEADP^PSSUTLA1
- Q
- SET ;
- D PARN^PSSORPH
- 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
- S (PSIEN,DLOOP)=+$P(PSSX(1),"^",4) K PSSMAX D:$G(TYPE)["O" MAX^PSSORPH
- 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)
- D REQS^PSSORPH S PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$G(PSSREQS)_"^"_$G(PSNNN)_"^"_$G(PSSVERB)
- Q
- AMP ;Replace & with AND when returning local doses to CPRS
- N PSSAB,PSSABT,PSSABA,PSSABL,PSSABZ,PSSABX,PSSABF1,PSSABF2
- I PSLOCV="&" S PSLOCV=" AND " Q
- I $E(PSLOCV,1)="&" D
- .I $E(PSLOCV,2)=" " S PSLOCV=" AND"_$E(PSLOCV,2,999) Q
- .S PSLOCV=" AND "_$E(PSLOCV,2,999)
- S PSSABL=$L(PSLOCV)
- I $E(PSLOCV,PSSABL)="&" D
- .I $E(PSLOCV,(PSSABL-1))=" " S PSLOCV=$E(PSLOCV,1,(PSSABL-1))_"AND " Q
- .S PSLOCV=$E(PSLOCV,1,(PSSABL-1))_" AND "
- Q:$G(PSLOCV)'["&"
- S PSSABT=0
- F PSSAB=1:1:$L(PSLOCV) I $E(PSLOCV,PSSAB)="&" S PSSABT=PSSABT+1
- F PSSAB=1:1:(PSSABT+1) S PSSABA(PSSAB)=$P(PSLOCV,"&") S PSLOCV=$P(PSLOCV,"&",2,999)
- F PSSABZ=1:1:PSSABT D
- .K PSSABF1,PSSABF2
- .I $L($G(PSSABA(PSSABZ)))>0 S PSSABF1=$E(PSSABA(PSSABZ),$L(PSSABA(PSSABZ)))
- .I $D(PSSABA(PSSABZ+1)) S PSSABF2=$E(PSSABA(PSSABZ+1),1)
- .S PSSABA(PSSABZ)=PSSABA(PSSABZ)_$S($G(PSSABF1)=" ":"AND",1:" AND")_$S($G(PSSABF2)=" ":"",1:" ")
- K PSLOCV F PSSABX=1:1:(PSSABT+1) S PSLOCV=$G(PSLOCV)_$G(PSSABA(PSSABX))
- Q
- AMPCHK ; CHECK FOR THE "&" IN THE NOUN FILED OF THE DOSAGE FORM FILE #50.606
- N PSLOCV
- S PSLOCV=X D AMP
- S X=$$TRIM^XLFSTR(PSLOCV,"LR"," ")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSORPH1 3613 printed Jan 18, 2025@03:34:08 Page 2
- PSSORPH1 ;BIR/RTR-Dosage by Dispense Units per Dose ;03/24/00
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,49,64,69,138**;9/30/97;Build 5
- +2 ;Reference to ^PS(50.607 supported by DBIA 2221
- +3 ;
- +4 SET DLOOP=$GET(PD)
- +5 if '$GET(DLOOP)
- QUIT
- +6 ;SET PSSX(1)=-1^DDRUG IS INACTIVE OR NOT APP USE ANYMORE?
- +7 IF $PIECE($GET(^PSDRUG(DLOOP,"I")),"^")&($PIECE($GET(^("I")),"^")'>DT)
- SET PSSX(1)="-1^Drug is inactive"
- QUIT
- +8 ;I $P($G(^PSDRUG(DLOOP,2)),"^",3)'[TYPE S PSSX(1)="-1^Drug not marked for application" Q
- +9 SET PSSTRN=$PIECE($GET(^PSDRUG(DLOOP,"DOS")),"^")
- SET PSSUNITZ=$PIECE($GET(^("DOS")),"^",2)
- +10 SET PSSUNITX=$SELECT($PIECE($GET(^PS(50.607,+$GET(PSSUNITZ),0)),"^")'=""&($PIECE($GET(^(0)),"^")'["/"):$PIECE($GET(^(0)),"^"),1:"")
- +11 SET PSSDSE=+$PIECE($GET(^PS(50.7,POPD,0)),"^",2)
- SET PSSVERB=$PIECE($GET(^PS(50.606,PSSDSE,"MISC")),"^")
- SET PSSPREP=$PIECE($GET(^("MISC")),"^",3)
- +12 KILL PSNNN
- FOR PSNN=0:0
- SET PSNN=$ORDER(^PS(50.606,PSSDSE,"NOUN",PSNN))
- if 'PSNN!($DATA(PSNNN))
- QUIT
- if $PIECE($GET(^(PSNN,0)),"^")'=""
- SET PSNNN=$PIECE($GET(^(0)),"^")
- +13 SET (PSSDOSE,PSSUNTS,PSSUDOS)=""
- +14 SET PSSUNTS=$PIECE($GET(^PS(50.607,+$PIECE($GET(^PSDRUG(DLOOP,"DOS")),"^",2),0)),"^")
- +15 SET PSSUDOS=$GET(PSSUPD)
- +16 ;S PSSDOSE=PSSUDOS*+PSSTRN
- +17 SET PSSDOSE=+$FNUMBER(PSSUDOS*+PSSTRN,"",10)
- +18 IF $GET(PSSTRN)=""!('$GET(PSSUNITZ))
- DO SET
- DO LEADP^PSSUTLA1
- QUIT
- +19 IF '$GET(PSSDOSE)!('$GET(PSSUDOS))
- DO SET
- DO LEADP^PSSUTLA1
- QUIT
- +20 SET DCNT1=1
- +21 DO PARN^PSSORPH
- +22 SET PSSX(DCNT1)=PSSDOSE_"^"_$SELECT("OX"[$GET(TYPE):$GET(PSSUNITZ),1:$GET(PSSUNTS))_"^"_PSSUDOS_"^"_DLOOP_"^"_$GET(PSSTRN)_"^"_$SELECT($GET(PSSNP)'="":$GET(PSSNP),1:$GET(PSNNN))_"^"_...
- ... $PIECE($GET(^PS(50.606,+$GET(PSSDSE),0)),"^")_"^"_$GET(PSSVERB)_"^"_$GET(PSSPREP)
- KILL PSSNP
- +23 SET PSSA=1
- DO SLS^PSSORPH
- +24 SET (PSIEN,DLOOP)=+$PIECE(PSSX(PSSA),"^",4)
- KILL PSSMAX
- if $GET(TYPE)["O"
- DO MAX^PSSORPH
- +25 SET PSSX("DD",PSIEN)=$PIECE($GET(^PSDRUG(PSIEN,0)),"^")_"^"_$PIECE($GET(^(660)),"^",6)_"^"_$PIECE($GET(^(0)),"^",9)_"^"_$PIECE($GET(^(660)),"^",8)_"^"_$PIECE($GET(^("DOS")),"^")_"^"_$GET(PSSUNITX)_"^"_$GET(PSSMAX)
- +26 DO REQS^PSSORPH
- SET PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$GET(PSSREQS)_"^"_$GET(PSNNN)_"^"_$GET(PSSVERB)
- +27 DO LEADP^PSSUTLA1
- +28 QUIT
- SET ;
- +1 DO PARN^PSSORPH
- +2 SET PSSX(1)="^"_$SELECT("OX"[$GET(TYPE):$GET(PSSUNITZ),1:$GET(PSSUNTS))_"^^"_DLOOP_"^"_$GET(PSSTRN)_"^"_$SELECT($GET(PSSNP)'="":$GET(PSSNP),1:$GET(PSNNN))_"^"_$PIECE($GET(^PS(50.606,+$GET(PSSDSE),0)),"^")_"^"_$GET(PSSVERB)_"^"_$GET(PSSPREP)
- KILL PSSNP
- +3 SET (PSIEN,DLOOP)=+$PIECE(PSSX(1),"^",4)
- KILL PSSMAX
- if $GET(TYPE)["O"
- DO MAX^PSSORPH
- +4 SET PSSX("DD",PSIEN)=$PIECE($GET(^PSDRUG(PSIEN,0)),"^")_"^"_$PIECE($GET(^(660)),"^",6)_"^"_$PIECE($GET(^(0)),"^",9)_"^"_$PIECE($GET(^(660)),"^",8)_"^"_$PIECE($GET(^("DOS")),"^")_"^"_$GET(PSSUNITX)_"^"_$GET(PSSMAX)
- +5 DO REQS^PSSORPH
- SET PSSX("DD",PSIEN)=PSSX("DD",PSIEN)_"^"_$GET(PSSREQS)_"^"_$GET(PSNNN)_"^"_$GET(PSSVERB)
- +6 QUIT
- AMP ;Replace & with AND when returning local doses to CPRS
- +1 NEW PSSAB,PSSABT,PSSABA,PSSABL,PSSABZ,PSSABX,PSSABF1,PSSABF2
- +2 IF PSLOCV="&"
- SET PSLOCV=" AND "
- QUIT
- +3 IF $EXTRACT(PSLOCV,1)="&"
- Begin DoDot:1
- +4 IF $EXTRACT(PSLOCV,2)=" "
- SET PSLOCV=" AND"_$EXTRACT(PSLOCV,2,999)
- QUIT
- +5 SET PSLOCV=" AND "_$EXTRACT(PSLOCV,2,999)
- End DoDot:1
- +6 SET PSSABL=$LENGTH(PSLOCV)
- +7 IF $EXTRACT(PSLOCV,PSSABL)="&"
- Begin DoDot:1
- +8 IF $EXTRACT(PSLOCV,(PSSABL-1))=" "
- SET PSLOCV=$EXTRACT(PSLOCV,1,(PSSABL-1))_"AND "
- QUIT
- +9 SET PSLOCV=$EXTRACT(PSLOCV,1,(PSSABL-1))_" AND "
- End DoDot:1
- +10 if $GET(PSLOCV)'["&"
- QUIT
- +11 SET PSSABT=0
- +12 FOR PSSAB=1:1:$LENGTH(PSLOCV)
- IF $EXTRACT(PSLOCV,PSSAB)="&"
- SET PSSABT=PSSABT+1
- +13 FOR PSSAB=1:1:(PSSABT+1)
- SET PSSABA(PSSAB)=$PIECE(PSLOCV,"&")
- SET PSLOCV=$PIECE(PSLOCV,"&",2,999)
- +14 FOR PSSABZ=1:1:PSSABT
- Begin DoDot:1
- +15 KILL PSSABF1,PSSABF2
- +16 IF $LENGTH($GET(PSSABA(PSSABZ)))>0
- SET PSSABF1=$EXTRACT(PSSABA(PSSABZ),$LENGTH(PSSABA(PSSABZ)))
- +17 IF $DATA(PSSABA(PSSABZ+1))
- SET PSSABF2=$EXTRACT(PSSABA(PSSABZ+1),1)
- +18 SET PSSABA(PSSABZ)=PSSABA(PSSABZ)_$SELECT($GET(PSSABF1)=" ":"AND",1:" AND")_$SELECT($GET(PSSABF2)=" ":"",1:" ")
- End DoDot:1
- +19 KILL PSLOCV
- FOR PSSABX=1:1:(PSSABT+1)
- SET PSLOCV=$GET(PSLOCV)_$GET(PSSABA(PSSABX))
- +20 QUIT
- AMPCHK ; CHECK FOR THE "&" IN THE NOUN FILED OF THE DOSAGE FORM FILE #50.606
- +1 NEW PSLOCV
- +2 SET PSLOCV=X
- DO AMP
- +3 SET X=$$TRIM^XLFSTR(PSLOCV,"LR"," ")
- +4 QUIT