PSSLDEDT ;BIR/RTR-Edit Local Possible Dosage Unit/Dosage ;06/23/07
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
;
;Reference to 50.607 supported by DBIA 2221
;
EDT ;Edit New Local Possible Dosages Fields Numeric Dose and Dose Unit
N DIRUT,DIROUT,DIC,DTOUT,DUOUT,X,Y,DIE,DA,DR,PSSLVIEN,PSSLVOK,PSSLVTST,PSSLVZR,PSSLVND1,PSSLVND3,PSSLVDF,PSSLVSTN,PSSLVUNT,PSSLVNDF,PSSLVSXX,PSSLVSZZ,PSSLVUNX,PSSLVLP,PSSLVLPN,PSSLVOUT,PSSLVLOC,PSSLVLCX,PSSLVFLG,PSSLVCNT
N PSSLVGG1,PSSLVGG2,PSSLVGG3,PSSLVGG4,PSSLVGG5,PSSLVGG6,PSSLVAF6,PSSLVBF6,DIR,DIDEL
EDTX ;
K PSSLVIEN,PSSLVOK,PSSLVTST,PSSLVZR,PSSLVND1,PSSLVND3,PSSLVDF,PSSLVSTN,PSSLVUNT,PSSLVNDF,PSSLVSXX,PSSLVSZZ,PSSLVUNX,PSSLVLP,PSSLVLPN,PSSLVOUT,PSSLVLOC,PSSLVLCX,PSSLVFLG,PSSLVCNT
K PSSLVGG1,PSSLVGG2,PSSLVGG3,PSSLVGG4,PSSLVGG5,PSSLVGG6,PSSLVAF6,PSSLVBF6
S PSSLVOUT=0
W ! K DIC,DTOUT,DUOUT S DIC=50,DIC(0)="QEAMZ",DIC("A")="Select Drug: " D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT))!(+Y'>0) W ! Q
S PSSLVIEN=+Y,PSSLVZR=$G(^PSDRUG(PSSLVIEN,0)),PSSLVND1=$P($G(^PSDRUG(PSSLVIEN,"ND")),"^"),PSSLVND3=$P($G(^PSDRUG(PSSLVIEN,"ND")),"^",3)
S PSSLVSTN=$P($G(^PSDRUG(PSSLVIEN,"DOS")),"^"),PSSLVUNT=$P($G(^PSDRUG(PSSLVIEN,"DOS")),"^",2)
S PSSLVOK=$$TEST(PSSLVIEN)
I 'PSSLVOK G EDTX
S PSSLVUNX=$S($G(PSSLVUNT):$P($G(^PS(50.607,+$G(PSSLVUNT),0)),"^"),$P($G(PSSLVNDF),"^",6)'="":$P($G(PSSLVNDF),"^",6),1:"")
I 'PSSLVND3!('PSSLVND1) W !!,"This drug is not matched to NDF and therefore will be excluded from dosing",!,"checks."
L +^PSDRUG(PSSLVIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T W !!,"Another person is editing this drug.",! G EDTX
I PSSLVND1,PSSLVND3 S PSSLVSXX=$P(PSSLVNDF,"^",4),PSSLVSZZ=$P(PSSLVNDF,"^",6)
I PSSLVSTN'="",$E($G(PSSLVSTN),1)="." S PSSLVSTN="0"_PSSLVSTN
I $G(PSSLVSXX)'="",$E($G(PSSLVSXX),1)="." S PSSLVSXX="0"_PSSLVSXX
S PSSLVFLG=0
I $G(PSSLVSXX)'="",($G(PSSLVSTN)'="") I $G(PSSLVSXX)'=$G(PSSLVSTN) D
.S PSSLVFLG=1
.S PSSLVGG1=$L($G(PSSLVSXX)),PSSLVGG2=$L($G(PSSLVUNX)),PSSLVGG3=$L($G(PSSLVSTN)),PSSLVGG4=$L($S($G(PSSLVUNX)'["/":$G(PSSLVUNX),1:""))
.W !!,"Strength from National Drug File match => " D
..I PSSLVGG1+PSSLVGG2<34 W $G(PSSLVSXX)_" "_$G(PSSLVUNX) Q
..W !?3,$G(PSSLVSXX) D
...I PSSLVGG1+PSSLVGG2<73 W " "_$G(PSSLVUNX) Q
...W !?3,$G(PSSLVUNX)
.W !,"Strength currently in the Drug File => " D
..I PSSLVGG3+PSSLVGG4<34 W $G(PSSLVSTN)_" "_$S($G(PSSLVUNX)'["/":$G(PSSLVUNX),1:"") Q
..W !?3,$G(PSSLVSTN) D
...I PSSLVGG3+PSSLVGG4<73 W " "_$S($G(PSSLVUNX)'["/":$G(PSSLVUNX),1:"") Q
...W !?3,$S($G(PSSLVUNX)'["/":$G(PSSLVUNX),1:"")
.W !!,"Please Note: Strength of drug does not match strength of VA Product it is",!,"matched to."
S PSSLVCNT=0
F PSSLVLP=0:0 S PSSLVLP=$O(^PSDRUG(PSSLVIEN,"DOS2",PSSLVLP)) Q:'PSSLVLP!(PSSLVOUT) S PSSLVLOC=$G(^PSDRUG(PSSLVIEN,"DOS2",PSSLVLP,0)) D:$P(PSSLVLOC,"^")'=""
.I 'PSSLVCNT,'PSSLVFLG I $G(PSSLVSXX)'=""!($G(PSSLVSTN)'="")!($G(PSSLVUNX)'="") D
..S PSSLVGG5=$L($S($G(PSSLVSTN)'="":$G(PSSLVSTN),$G(PSSLVSXX)'="":$G(PSSLVSXX),1:"")),PSSLVGG6=$L($G(PSSLVUNX))
..W !!,"Strength: "_$S($G(PSSLVSTN)'="":$G(PSSLVSTN),$G(PSSLVSXX)'="":$G(PSSLVSXX),1:"")
..I PSSLVGG5+PSSLVGG6<60 W " Unit: "_$G(PSSLVUNX) Q
..W !,"Unit: "_$G(PSSLVUNX)
.S PSSLVCNT=1
.W !!!,$P(PSSLVLOC,"^") I $P(PSSLVLOC,"^",5)!($P(PSSLVLOC,"^",6)'="") D
..W !,"Numeric Dose: "_$S($E($P(PSSLVLOC,"^",6),1)=".":"0"_$P(PSSLVLOC,"^",6),1:$P(PSSLVLOC,"^",6))
..W ?37,"Dose Unit: "_$S('$P(PSSLVLOC,"^",5):"",1:$P($G(^PS(51.24,+$P(PSSLVLOC,"^",5),0)),"^"))
.W ! K DIE,Y,DTOUT,DR,DA,DIDEL S DA(1)=PSSLVIEN,DIE="^PSDRUG("_PSSLVIEN_",""DOS2"",",DR="4;5",DA=PSSLVLP
.D ^DIE K DIE,DR,DA I $D(DTOUT)!($D(Y)) D Q:PSSLVOUT
..W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to exit this option",DIR("B")="Y",DIR("?")="Enter 'Y' to exit this option, enter 'N' to continue editing."
..D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!($G(Y)) S PSSLVOUT=1
.S PSSLVLCX=$G(^PSDRUG(PSSLVIEN,"DOS2",PSSLVLP,0))
.S PSSLVBF6=$S($E($P(PSSLVLOC,"^",6),1)=".":"0"_$P(PSSLVLOC,"^",6),1:$P(PSSLVLOC,"^",6)) S PSSLVAF6=$S($E($P(PSSLVLCX,"^",6),1)=".":"0"_$P(PSSLVLCX,"^",6),1:$P(PSSLVLCX,"^",6))
.I $P(PSSLVLCX,"^",5)'=$P(PSSLVLOC,"^",5)!(PSSLVBF6'=PSSLVAF6) D
..W !!,$P(PSSLVLCX,"^")
..W !,"Numeric Dose: "_$S($E($P(PSSLVLCX,"^",6),1)=".":"0"_$P(PSSLVLCX,"^",6),1:$P(PSSLVLCX,"^",6))
..W ?40,"Dose Unit: "_$S('$P(PSSLVLCX,"^",5):"",1:$P($G(^PS(51.24,+$P(PSSLVLCX,"^",5),0)),"^"))
D UL
I 'PSSLVOUT G EDTX
Q
;
UL ;unlock drug
L -^PSDRUG(PSSLVIEN)
Q
;
TEST(PSSLVTST) ;See if drug need Dose Unit and Numeric Dose defined
N PSSLVDOV
S PSSLVDOV=""
I PSSLVND1,PSSLVND3,$T(OVRIDE^PSNAPIS)]"" S PSSLVDOV=$$OVRIDE^PSNAPIS(PSSLVND1,PSSLVND3)
I '$O(^PSDRUG(PSSLVTST,"DOS2",0)) W !!,"No local possible dosages exist for this drug." Q 0
I $P(PSSLVZR,"^",3)["S"!($E($P(PSSLVZR,"^",2),1,2)="XA") D Q 0
.W !!,"This drug is marked as a supply and therefore excluded from dosing checks."
.W !,"Population of the numeric dose and dose unit for this drug's local possible"
.W !,"dosages is not required."
I PSSLVND1,PSSLVND3 S PSSLVNDF=$$DFSU^PSNAPIS(PSSLVND1,PSSLVND3) S PSSLVDF=$P(PSSLVNDF,"^")
I $G(PSSLVDF)'>0,$P($G(^PSDRUG(PSSLVTST,2)),"^") S PSSLVDF=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSLVTST,2)),"^"),0)),"^",2)
I PSSLVDOV=""!('$G(PSSLVDF))!($P($G(^PS(50.606,+$G(PSSLVDF),1)),"^")="") Q 1
I $P($G(^PS(50.606,+$G(PSSLVDF),1)),"^"),'PSSLVDOV D Q 0
.W !!,"The dosage form '"_$P($G(^PS(50.606,+PSSLVDF,0)),"^")_"' associated with the drug has"
.W !,"been excluded from dosage checks. Population of the numeric dose and dose"
.W !,"unit for this drug's local possible dosages is not required."
I '$P($G(^PS(50.606,+$G(PSSLVDF),1)),"^"),PSSLVDOV D Q 0
.W !!,"The VA product that this drug is matched to has been excluded from dosage"
.W !,"checks. Population of the numeric dose and dose unit for this drug's local"
.W !,"possible dosages is not required."
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSLDEDT 5935 printed Dec 13, 2024@02:32:55 Page 2
PSSLDEDT ;BIR/RTR-Edit Local Possible Dosage Unit/Dosage ;06/23/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
+2 ;
+3 ;Reference to 50.607 supported by DBIA 2221
+4 ;
EDT ;Edit New Local Possible Dosages Fields Numeric Dose and Dose Unit
+1 NEW DIRUT,DIROUT,DIC,DTOUT,DUOUT,X,Y,DIE,DA,DR,PSSLVIEN,PSSLVOK,PSSLVTST,PSSLVZR,PSSLVND1,PSSLVND3,PSSLVDF,PSSLVSTN,PSSLVUNT,PSSLVNDF,PSSLVSXX,PSSLVSZZ,PSSLVUNX,PSSLVLP,PSSLVLPN,PSSLVOUT,PSSLVLOC,PSSLVLCX,PSSLVFLG,PSSLVCNT
+2 NEW PSSLVGG1,PSSLVGG2,PSSLVGG3,PSSLVGG4,PSSLVGG5,PSSLVGG6,PSSLVAF6,PSSLVBF6,DIR,DIDEL
EDTX ;
+1 KILL PSSLVIEN,PSSLVOK,PSSLVTST,PSSLVZR,PSSLVND1,PSSLVND3,PSSLVDF,PSSLVSTN,PSSLVUNT,PSSLVNDF,PSSLVSXX,PSSLVSZZ,PSSLVUNX,PSSLVLP,PSSLVLPN,PSSLVOUT,PSSLVLOC,PSSLVLCX,PSSLVFLG,PSSLVCNT
+2 KILL PSSLVGG1,PSSLVGG2,PSSLVGG3,PSSLVGG4,PSSLVGG5,PSSLVGG6,PSSLVAF6,PSSLVBF6
+3 SET PSSLVOUT=0
+4 WRITE !
KILL DIC,DTOUT,DUOUT
SET DIC=50
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Drug: "
DO ^DIC
KILL DIC
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
WRITE !
QUIT
+6 SET PSSLVIEN=+Y
SET PSSLVZR=$GET(^PSDRUG(PSSLVIEN,0))
SET PSSLVND1=$PIECE($GET(^PSDRUG(PSSLVIEN,"ND")),"^")
SET PSSLVND3=$PIECE($GET(^PSDRUG(PSSLVIEN,"ND")),"^",3)
+7 SET PSSLVSTN=$PIECE($GET(^PSDRUG(PSSLVIEN,"DOS")),"^")
SET PSSLVUNT=$PIECE($GET(^PSDRUG(PSSLVIEN,"DOS")),"^",2)
+8 SET PSSLVOK=$$TEST(PSSLVIEN)
+9 IF 'PSSLVOK
GOTO EDTX
+10 SET PSSLVUNX=$SELECT($GET(PSSLVUNT):$PIECE($GET(^PS(50.607,+$GET(PSSLVUNT),0)),"^"),$PIECE($GET(PSSLVNDF),"^",6)'="":$PIECE($GET(PSSLVNDF),"^",6),1:"")
+11 IF 'PSSLVND3!('PSSLVND1)
WRITE !!,"This drug is not matched to NDF and therefore will be excluded from dosing",!,"checks."
+12 LOCK +^PSDRUG(PSSLVIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE !!,"Another person is editing this drug.",!
GOTO EDTX
+13 IF PSSLVND1
IF PSSLVND3
SET PSSLVSXX=$PIECE(PSSLVNDF,"^",4)
SET PSSLVSZZ=$PIECE(PSSLVNDF,"^",6)
+14 IF PSSLVSTN'=""
IF $EXTRACT($GET(PSSLVSTN),1)="."
SET PSSLVSTN="0"_PSSLVSTN
+15 IF $GET(PSSLVSXX)'=""
IF $EXTRACT($GET(PSSLVSXX),1)="."
SET PSSLVSXX="0"_PSSLVSXX
+16 SET PSSLVFLG=0
+17 IF $GET(PSSLVSXX)'=""
IF ($GET(PSSLVSTN)'="")
IF $GET(PSSLVSXX)'=$GET(PSSLVSTN)
Begin DoDot:1
+18 SET PSSLVFLG=1
+19 SET PSSLVGG1=$LENGTH($GET(PSSLVSXX))
SET PSSLVGG2=$LENGTH($GET(PSSLVUNX))
SET PSSLVGG3=$LENGTH($GET(PSSLVSTN))
SET PSSLVGG4=$LENGTH($SELECT($GET(PSSLVUNX)'["/":$GET(PSSLVUNX),1:""))
+20 WRITE !!,"Strength from National Drug File match => "
Begin DoDot:2
+21 IF PSSLVGG1+PSSLVGG2<34
WRITE $GET(PSSLVSXX)_" "_$GET(PSSLVUNX)
QUIT
+22 WRITE !?3,$GET(PSSLVSXX)
Begin DoDot:3
+23 IF PSSLVGG1+PSSLVGG2<73
WRITE " "_$GET(PSSLVUNX)
QUIT
+24 WRITE !?3,$GET(PSSLVUNX)
End DoDot:3
End DoDot:2
+25 WRITE !,"Strength currently in the Drug File => "
Begin DoDot:2
+26 IF PSSLVGG3+PSSLVGG4<34
WRITE $GET(PSSLVSTN)_" "_$SELECT($GET(PSSLVUNX)'["/":$GET(PSSLVUNX),1:"")
QUIT
+27 WRITE !?3,$GET(PSSLVSTN)
Begin DoDot:3
+28 IF PSSLVGG3+PSSLVGG4<73
WRITE " "_$SELECT($GET(PSSLVUNX)'["/":$GET(PSSLVUNX),1:"")
QUIT
+29 WRITE !?3,$SELECT($GET(PSSLVUNX)'["/":$GET(PSSLVUNX),1:"")
End DoDot:3
End DoDot:2
+30 WRITE !!,"Please Note: Strength of drug does not match strength of VA Product it is",!,"matched to."
End DoDot:1
+31 SET PSSLVCNT=0
+32 FOR PSSLVLP=0:0
SET PSSLVLP=$ORDER(^PSDRUG(PSSLVIEN,"DOS2",PSSLVLP))
if 'PSSLVLP!(PSSLVOUT)
QUIT
SET PSSLVLOC=$GET(^PSDRUG(PSSLVIEN,"DOS2",PSSLVLP,0))
if $PIECE(PSSLVLOC,"^")'=""
Begin DoDot:1
+33 IF 'PSSLVCNT
IF 'PSSLVFLG
IF $GET(PSSLVSXX)'=""!($GET(PSSLVSTN)'="")!($GET(PSSLVUNX)'="")
Begin DoDot:2
+34 SET PSSLVGG5=$LENGTH($SELECT($GET(PSSLVSTN)'="":$GET(PSSLVSTN),$GET(PSSLVSXX)'="":$GET(PSSLVSXX),1:""))
SET PSSLVGG6=$LENGTH($GET(PSSLVUNX))
+35 WRITE !!,"Strength: "_$SELECT($GET(PSSLVSTN)'="":$GET(PSSLVSTN),$GET(PSSLVSXX)'="":$GET(PSSLVSXX),1:"")
+36 IF PSSLVGG5+PSSLVGG6<60
WRITE " Unit: "_$GET(PSSLVUNX)
QUIT
+37 WRITE !,"Unit: "_$GET(PSSLVUNX)
End DoDot:2
+38 SET PSSLVCNT=1
+39 WRITE !!!,$PIECE(PSSLVLOC,"^")
IF $PIECE(PSSLVLOC,"^",5)!($PIECE(PSSLVLOC,"^",6)'="")
Begin DoDot:2
+40 WRITE !,"Numeric Dose: "_$SELECT($EXTRACT($PIECE(PSSLVLOC,"^",6),1)=".":"0"_$PIECE(PSSLVLOC,"^",6),1:$PIECE(PSSLVLOC,"^",6))
+41 WRITE ?37,"Dose Unit: "_$SELECT('$PIECE(PSSLVLOC,"^",5):"",1:$PIECE($GET(^PS(51.24,+$PIECE(PSSLVLOC,"^",5),0)),"^"))
End DoDot:2
+42 WRITE !
KILL DIE,Y,DTOUT,DR,DA,DIDEL
SET DA(1)=PSSLVIEN
SET DIE="^PSDRUG("_PSSLVIEN_",""DOS2"","
SET DR="4;5"
SET DA=PSSLVLP
+43 DO ^DIE
KILL DIE,DR,DA
IF $DATA(DTOUT)!($DATA(Y))
Begin DoDot:2
+44 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to exit this option"
SET DIR("B")="Y"
SET DIR("?")="Enter 'Y' to exit this option, enter 'N' to continue editing."
+45 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(Y))
SET PSSLVOUT=1
End DoDot:2
if PSSLVOUT
QUIT
+46 SET PSSLVLCX=$GET(^PSDRUG(PSSLVIEN,"DOS2",PSSLVLP,0))
+47 SET PSSLVBF6=$SELECT($EXTRACT($PIECE(PSSLVLOC,"^",6),1)=".":"0"_$PIECE(PSSLVLOC,"^",6),1:$PIECE(PSSLVLOC,"^",6))
SET PSSLVAF6=$SELECT($EXTRACT($PIECE(PSSLVLCX,"^",6),1)=".":"0"_$PIECE(PSSLVLCX,"^",6),1:$PIECE(PSSLVLCX,"^",6))
+48 IF $PIECE(PSSLVLCX,"^",5)'=$PIECE(PSSLVLOC,"^",5)!(PSSLVBF6'=PSSLVAF6)
Begin DoDot:2
+49 WRITE !!,$PIECE(PSSLVLCX,"^")
+50 WRITE !,"Numeric Dose: "_$SELECT($EXTRACT($PIECE(PSSLVLCX,"^",6),1)=".":"0"_$PIECE(PSSLVLCX,"^",6),1:$PIECE(PSSLVLCX,"^",6))
+51 WRITE ?40,"Dose Unit: "_$SELECT('$PIECE(PSSLVLCX,"^",5):"",1:$PIECE($GET(^PS(51.24,+$PIECE(PSSLVLCX,"^",5),0)),"^"))
End DoDot:2
End DoDot:1
+52 DO UL
+53 IF 'PSSLVOUT
GOTO EDTX
+54 QUIT
+55 ;
UL ;unlock drug
+1 LOCK -^PSDRUG(PSSLVIEN)
+2 QUIT
+3 ;
TEST(PSSLVTST) ;See if drug need Dose Unit and Numeric Dose defined
+1 NEW PSSLVDOV
+2 SET PSSLVDOV=""
+3 IF PSSLVND1
IF PSSLVND3
IF $TEXT(OVRIDE^PSNAPIS)]""
SET PSSLVDOV=$$OVRIDE^PSNAPIS(PSSLVND1,PSSLVND3)
+4 IF '$ORDER(^PSDRUG(PSSLVTST,"DOS2",0))
WRITE !!,"No local possible dosages exist for this drug."
QUIT 0
+5 IF $PIECE(PSSLVZR,"^",3)["S"!($EXTRACT($PIECE(PSSLVZR,"^",2),1,2)="XA")
Begin DoDot:1
+6 WRITE !!,"This drug is marked as a supply and therefore excluded from dosing checks."
+7 WRITE !,"Population of the numeric dose and dose unit for this drug's local possible"
+8 WRITE !,"dosages is not required."
End DoDot:1
QUIT 0
+9 IF PSSLVND1
IF PSSLVND3
SET PSSLVNDF=$$DFSU^PSNAPIS(PSSLVND1,PSSLVND3)
SET PSSLVDF=$PIECE(PSSLVNDF,"^")
+10 IF $GET(PSSLVDF)'>0
IF $PIECE($GET(^PSDRUG(PSSLVTST,2)),"^")
SET PSSLVDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSLVTST,2)),"^"),0)),"^",2)
+11 IF PSSLVDOV=""!('$GET(PSSLVDF))!($PIECE($GET(^PS(50.606,+$GET(PSSLVDF),1)),"^")="")
QUIT 1
+12 IF $PIECE($GET(^PS(50.606,+$GET(PSSLVDF),1)),"^")
IF 'PSSLVDOV
Begin DoDot:1
+13 WRITE !!,"The dosage form '"_$PIECE($GET(^PS(50.606,+PSSLVDF,0)),"^")_"' associated with the drug has"
+14 WRITE !,"been excluded from dosage checks. Population of the numeric dose and dose"
+15 WRITE !,"unit for this drug's local possible dosages is not required."
End DoDot:1
QUIT 0
+16 IF '$PIECE($GET(^PS(50.606,+$GET(PSSLVDF),1)),"^")
IF PSSLVDOV
Begin DoDot:1
+17 WRITE !!,"The VA product that this drug is matched to has been excluded from dosage"
+18 WRITE !,"checks. Population of the numeric dose and dose unit for this drug's local"
+19 WRITE !,"possible dosages is not required."
End DoDot:1
QUIT 0
+20 QUIT 1
