PSSDOS ;BIR/RTR-Dose edit option ;03/10/00
;;1.0;PHARMACY DATA MANAGEMENT;**38,49,50,47,129,147,155**;9/30/97;Build 36
;
;Reference to PS(50.607 supported by DBIA 2221
DOSN ;
N X,Y,PSSNFID,PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNOCON,PSSST,PSSUN,PSSNAME,PSSIND,PSSDOSA,PSSXYZ,PSSNATST,POSDOS,LPDOS
N PSSDIEN,PSSONLYI,PSSONLYO,PSSTALK,PSSIZZ,PSSOZZ,PSSSKIPP,PSSWDXF
N PSSUPRA,PSSIEN S PSSIEN=DA
DOSNX ;
D STUN
I PSSST="",$O(^PSDRUG(PSSIEN,"DOS1",0)) K ^PSDRUG(PSSIEN,"DOS") K ^PSDRUG(PSSIEN,"DOS1")
S (PSSIZZ,PSSOZZ)=0 S:'$G(PSSSKIPP) PSSSKIPP=0
S PSSXYZ=0 D CHECK
;Display strength
D:$P($G(^PSDRUG(PSSIEN,"DOS")),"^")'="" XNWS
I PSSXYZ,PSSUPRA="NN" D:$P($G(^PSDRUG(PSSIEN,"DOS")),"^")="" XNW G DOSA
I $P($G(^PSDRUG(PSSIEN,"DOS")),"^")'="",$O(^PSDRUG(PSSIEN,"DOS1",0)) N PSSIENS,PSS11 G DOSA
;.N PSSDESTP W !!,"Strength from National Drug File match => "_$S($E($G(PSSNATST),1)=".":"0",1:"")_$G(PSSNATST)_" "_$P($G(^PS(50.607,+$G(PSSUN),0)),"^")
;.W !,"Strength currently in the Drug File => "_$S($E($P($G(^PSDRUG(PSSIEN,"DOS")),"^"),1)=".":"0",1:"")_$P($G(^PSDRUG(PSSIEN,"DOS")),"^")_" "_$S($P($G(^PS(50.607,+$G(PSSUN),0)),"^")'["/":$P($G(^(0)),"^"),1:"") S PSSDESTP=1 D MS^PSSDSPOP
;.K PSSDESTP
;
I $G(PSSXYZ),'$O(^PSDRUG(PSSIEN,"DOS1",0)) D D ^DIR K DIR I Y=1 S PSSSKIPP=1 D EN2^PSSUTIL(PSSIEN,1) G DOSNX
.K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Create Possible Dosages for this drug",DIR("?")=" "
.S DIR("?",1)="This drug meets the criteria to have Possible Dosages, but it currently does",DIR("?",2)="not have any. If you answer 'YES', Possible Dosages will be created for this"
.S DIR("?",3)="drug, based on the match to the National Drug File."
.W !!,"This drug can have Possible Dosages, but currently does not have any.",!
.I $G(PSSUPRAF)=2,(PSSUPRA="NO"!(PSSUPRA="NB")) W !,"This drug has been set within the National Drug File to auto create "_$S(PSSUPRA="NO":"only one ",PSSUPRA="NB":"two ",1:""),!,"possible dosage"_$S(PSSUPRA="NO":".",1:"s."),!
I '$O(^PSDRUG(PSSIEN,"DOS1",0)) D LPD,QUES G:'Y END G LOCX
DOSA S PSSST=$P($G(^PSDRUG(PSSIEN,"DOS")),"^") S PSSWDXF=0
W !!,"Strength => "_$S($E($G(PSSST),1)=".":"0",1:"")_$G(PSSST)_" Unit => "_$S($P($G(^PS(50.607,+$G(PSSUN),0)),"^")'["/":$P($G(^(0)),"^"),1:"") W !
;;;I $D(^PSDRUG(PSSIEN,"DOS1"))
D:($Y+5)>IOSL QASK G:PSSWDXF WXF W !,"POSSIBLE DOSAGES:" D
.F PDS=0:0 S PDS=$O(^PSDRUG(PSSIEN,"DOS1",PDS)) Q:'PDS!(PSSWDXF) D
..S POSDOS=$G(^PSDRUG(PSSIEN,"DOS1",PDS,0))
..D:($Y+5)>IOSL QASK Q:PSSWDXF W !," DISPENSE UNITS PER DOSE: ",$S($E($P(POSDOS,U),1)=".":"0",1:"")_$P(POSDOS,U) D
...S X=$P(POSDOS,U) D SET^PSSDOSLZ W ?38,"DOSE: ",X,?60,"PACKAGE: ",$P(POSDOS,U,3)
;;;I $D(^PSDRUG(PSSIEN,"DOS2"))
S PSSWDXF=0 W !!,"LOCAL POSSIBLE DOSAGES:" D
.F PDS=0:0 S PDS=$O(^PSDRUG(PSSIEN,"DOS2",PDS)) Q:'PDS!(PSSWDXF) D
..D:($Y+5)>IOSL QASK Q:PSSWDXF S LPDOS=$G(^PSDRUG(PSSIEN,"DOS2",PDS,0)) W !," LOCAL POSSIBLE DOSAGE: " D
...I $L($P(LPDOS,U))'>27 W $P(LPDOS,U),?55,"PACKAGE: ",$P(LPDOS,U,2) D WXFPT(LPDOS) Q
...W !,?10,$P(LPDOS,U),!,?55,"PACKAGE: ",$P(LPDOS,U,2) D WXFPT(LPDOS)
WXF ;
I $$CHECK^PSSUTIL3(PSSIEN),($G(PSSUPRAF)'=2) D
.I PSSUPRA="NN" W !!,"Due to National Drug File settings no possible dosages were auto-created."
.I PSSUPRA="NO" W !!,"Due to National Drug File settings only ONE possible dosage was auto-created.",!,"If other dosages are needed, create POSSIBLE DOSAGES or LOCAL POSSIBLE DOSAGES",!,"as appropriate."
.I PSSUPRA="NB" W !!,"Due to National Drug File settings TWO possible dosages were auto-created."
I $E(PSSUPRA)="N",($G(PSSUPRAF)=2) D
.I PSSUPRA["N" W !!,"This drug has been set within the National Drug File to "_$S(PSSUPRA="NN":"not ",1:"")_"auto create "_$S(PSSUPRA="NO":"only one ",PSSUPRA="NB":"two ",1:""),!,"possible dosage"_$S(PSSUPRA="NO":".",1:"s.")
.S DIR("?",1)="This drug meets the criteria to have Possible Dosages, but it currently does",DIR("?",2)="not have any. If you answer 'YES', Possible Dosages will be created for this"
.S DIR("?",3)="drug, based on the match to the National Drug File."
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to "_$S(PSSUPRA="NN"&('$O(^PSDRUG(PSSIEN,"DOS1",0))):"manually enter possible",1:"edit the")_" dosages",DIR("B")="N"
I $G(PSSXYZ),'$O(^PSDRUG(PSSIEN,"DOS1",0)),$E(PSSUPRA)="N" D
.S DIR("?")=" ",DIR("?",1)="This drug meets the criteria to have Possible Dosages, but it currently does",DIR("?",2)="not have any. If you answer 'YES', Possible Dosages can be manually entered for this drug."
D ^DIR K DIR I 'Y W ! D END Q
I $G(PSSST) W !!,"Changing the strength will update all possible dosages for this Drug.",!
;Edit Strength
I $G(PSSST) W ! K DIE S DIE="^PSDRUG(",DA=PSSIEN,DR=901 D ^DIE W ! K DIE,PSSXYZ I $P($G(^PSDRUG(PSSIEN,"DOS")),"^")="" K ^PSDRUG(PSSIEN,"DOS") K ^PSDRUG(PSSIEN,"DOS1") W !!,"Deleting Strength has deleted all Possible Dosages!",!
I '$P($G(^PSDRUG(PSSIEN,"DOS")),"^") D LPD D QUES G:'Y END G LOC
;
DOSA1 K DIC S DA(1)=PSSIEN,DIC="^PSDRUG("_PSSIEN_",""DOS1"",",DIC(0)="QEAMLZ",DIC("A")="Select DISPENSE UNITS PER DOSE: " D D ^DIC K DIC I Y<1!($D(DTOUT))!($D(DUOUT)) G DOSLOC
.S DIC("W")="W "" ""_$S($E($P($G(^PSDRUG(PSSIEN,""DOS1"",+Y,0)),""^"",2),1)=""."":""0"",1:"""")_$P($G(^PSDRUG(PSSIEN,""DOS1"",+Y,0)),""^"",2)_"" ""_$P($G(^PSDRUG(PSSIEN,""DOS1"",+Y,0)),""^"",3)"
S PSSDOSA=+Y
W ! K DIE S DA(1)=PSSIEN,DA=PSSDOSA,DR=".01;2",DIE="^PSDRUG("_PSSIEN_",""DOS1""," D ^DIE K DIE D:'$D(Y)&('$D(DTOUT)) BCMA^PSSDOSER G:$D(Y)!($D(DTOUT)) DOSLOC
W ! G DOSA1
DOSLOC ;
S (PSSPCI,PSSPCO)=0
F PSSPCZ=0:0 S PSSPCZ=$O(^PSDRUG(PSSIEN,"DOS1",PSSPCZ)) Q:'PSSPCZ D
.I $P($G(^PSDRUG(PSSIEN,"DOS1",PSSPCZ,0)),"^",2)'="" S:$P($G(^(0)),"^",3)["I" PSSPCI=1 S:$P($G(^(0)),"^",3)["O" PSSPCO=1
I PSSPCI,PSSPCO W !! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Enter/Edit Local Possible Dosages" D D ^DIR K DIR I Y'=1 K PSSPCI,PSSPCO,PSSPCZ W ! D END Q
.S DIR("?")=" ",DIR("?",1)="Possible Dosages exist for both Outpatient Pharmacy and Inpatient Medications.",DIR("?",2)="Local Possible Dosages can be added, but will not be displayed for selection"
.S DIR("?",3)="as long as there are Possible Dosages.",DIR("?",4)=" ",DIR("?",5)="Enter 'Y' to Enter/Edit Local Possible Dosages."
K PSSPCI,PSSPCO,PSSPCZ
;
LOCX ;
I $G(PSSSKIPP) G LOC
I $G(PSSIZZ),$G(PSSOZZ) G LOC
K PSSONLYO,PSSONLYI
I $G(PSSIZZ),'$G(PSSOZZ) S PSSONLYO=1
I $G(PSSOZZ),'$G(PSSIZZ) S PSSONLYI=1
S PSSTALK=1,PSSDIEN=PSSIEN D LOC^PSSUTIL K PSSONLYI,PSSONLYO,PSSTALK,PSSDIEN
LOC ; Edit local dose
D STUN,NATND,PR
W ! K DIC S DA(1)=PSSIEN,DIC="^PSDRUG("_PSSIEN_",""DOS2"",",DIC(0)="QEAMLZ" D D ^DIC K DIC I Y<1!($D(DTOUT))!($D(DUOUT)) D END Q
.S DIC("W")="W "" ""_$P($G(^PSDRUG(PSSIEN,""DOS2"",+Y,0)),""^"",2)"
S PSSDOSA=+Y,PSSOTH=$S($P($G(^PS(59.7,1,40.2)),"^"):1,1:0)
W ! K DIE S DA(1)=PSSIEN,DA=PSSDOSA,DR=".01;S:'$G(PSSOTH) Y=""@1"";3;@1;1",DIE="^PSDRUG("_PSSIEN_",""DOS2"","
D ^DIE K DIE,PSSOTH G:$P($G(^PSDRUG(PSSIEN,"DOS2",PSSDOSA,0)),"^")="" LOC D:'$D(Y)&('$D(DTOUT)) BCMA1^PSSDOSER I $D(Y)!($D(DTOUT)) D END Q
I $$TEST^PSSDSPOP(PSSIEN) K DA,DIE,DR,DIDEL S DA(1)=PSSIEN,DA=PSSDOSA,DR="4;5",DIE="^PSDRUG("_PSSIEN_",""DOS2""," D ^DIE K DIE,DA,DR,DIDEL I $D(Y)!($D(DTOUT)) D END Q
G LOC
LPD ; Display local dose before edit
S PSSWDXF=0 D:($Y+5)>IOSL QASK Q:PSSWDXF W !!,"LOCAL POSSIBLE DOSAGES:" D
.F PDS=0:0 S PDS=$O(^PSDRUG(PSSIEN,"DOS2",PDS)) Q:'PDS!(PSSWDXF) D
..D:($Y+5)>IOSL QASK Q:PSSWDXF S LPDOS=$G(^PSDRUG(PSSIEN,"DOS2",PDS,0)) W !," " D
...I $L($P(LPDOS,U))'>27 W $P(LPDOS,U),?55,"PACKAGE: ",$P(LPDOS,U,2) D WXFPT(LPDOS) Q
...W !,?10,$P(LPDOS,U),!,?55,"PACKAGE: ",$P(LPDOS,U,2) D WXFPT(LPDOS)
Q
CHECK ;
K PSSUPRA,PSSNAT,PSSNATND,PSSNATDF,PSSNATUN,PSSNATST,PSSIZZ,PSSOZZ
D NATND
;I $G(PSSST) S PSSXYZ=1 Q
Q:'PSSNATDF!('PSSNATUN)!($G(PSSNATST)="")
Q:'$D(^PS(50.606,PSSNATDF,0))!('$D(^PS(50.607,PSSNATUN,0)))
I PSSNATST'?.N&(PSSNATST'?.N1".".N) Q
I $D(^PS(50.606,"ACONI",PSSNATDF,PSSNATUN)),$O(^PS(50.606,"ADUPI",PSSNATDF,0)) S (PSSXYZ,PSSIZZ)=1
I $D(^PS(50.606,"ACONO",PSSNATDF,PSSNATUN)),$O(^PS(50.606,"ADUPO",PSSNATDF,0)) S (PSSXYZ,PSSOZZ)=1
Q
END K PSSNFID,PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNOCON,PSSST,PSSUN,PSSIEN,PSSNAME,PSSIND,PSSDOSA,PSSXYZ,PSSNATST
Q
ULK ;No need to unlock, called from Drug enter/edit
Q:'$G(PSSIEN)
L -^PSDRUG(PSSIEN)
Q
QUES ;
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to edit Local Possible Dosages",DIR("B")="N" D ^DIR K DIR Q
Q
STUN S PSSST=$P($G(^PSDRUG(PSSIEN,"DOS")),"^"),PSSUN=$P($G(^("DOS")),"^",2)
Q
NATND S PSSNAT=+$P($G(^PSDRUG(PSSIEN,"ND")),"^",3),PSSNAT1=$P($G(^("ND")),"^")
S PSSNATND=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT) S PSSNATDF=$P(PSSNATND,"^"),PSSNATST=$P(PSSNATND,"^",4),PSSNATUN=$P(PSSNATND,"^",5)
S PSSUPRA=$$SUPRA^PSSUTIL3(PSSNAT)
Q
PR I PSSST'=""!(PSSNATST'=""),(PSSUN!(PSSNATUN)) D
.W !!,"Strength: "_$S($E($S(PSSST'="":PSSST,1:PSSNATST),1)=".":"0",1:"")_$S(PSSST'="":PSSST,1:PSSNATST)
.W ?30,"Unit: "_$P($G(^PS(50.607,+$S(PSSUN:PSSUN,1:PSSNATUN),0)),"^")
E W !!,"Strength: ",?30,"Unit: "
Q
XNW ;
I $P(^PSDRUG(PSSIEN,"ND"),"^",2)]"",('$D(^PSDRUG(PSSIEN,"DOS"))) S ^PSDRUG(PSSIEN,"DOS")=PSSNATST_"^"_PSSNATUN
XNWS ;
N PSSDESTP W !!,"Strength from National Drug File match => "_$S($E($G(PSSNATST),1)=".":"0",1:"")_$G(PSSNATST)_" "_$P($G(^PS(50.607,+$G(PSSUN),0)),"^")
W !,"Strength currently in the Drug File => "_$S($E($P($G(^PSDRUG(PSSIEN,"DOS")),"^"),1)=".":"0",1:"")_$P($G(^PSDRUG(PSSIEN,"DOS")),"^")_" "_$S($P($G(^PS(50.607,+$G(PSSUN),0)),"^")'["/":$P($G(^(0)),"^"),1:"") S PSSDESTP=1 D MS^PSSDSPOP
K PSSDESTP
Q
;
;
QASK ;Ask to continue
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR I 'Y S PSSWDXF=1
W @IOF
Q
;
;
WXFPT(PSSWDXVL) ;Add print fields with PSS*1*147
N PSSWDX1,PSSWDX2,PSSWDX3,PSSWDX4,PSSWDX5,PSSWDX6
S PSSWDX4=""
S PSSWDX1=$P(PSSWDXVL,"^",3),PSSWDX2=$P(PSSWDXVL,"^",5),PSSWDX3=$P(PSSWDXVL,"^",6)
I PSSWDX2 S PSSWDX4=$P($G(^PS(51.24,+PSSWDX2,0)),"^")
S PSSWDX5=$S($E(PSSWDX3)=".":"0",1:"")_PSSWDX3
S PSSWDX6=$L(PSSWDX5)
D:($Y+5)>IOSL QASK Q:PSSWDXF W !?4,"BCMA UNITS PER DOSE: "_PSSWDX1
I PSSWDX6<12 D:($Y+5)>IOSL QASK Q:PSSWDXF W !?4," NUMERIC DOSE: "_PSSWDX5,?38,"DOSE UNIT: "_PSSWDX4 Q
D:($Y+5)>IOSL QASK Q:PSSWDXF W !,?4," NUMERIC DOSE: "_PSSWDX5
D:($Y+5)>IOSL QASK Q:PSSWDXF W !,?38,"DOSE UNIT: "_PSSWDX4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDOS 10523 printed Oct 16, 2024@18:31:38 Page 2
PSSDOS ;BIR/RTR-Dose edit option ;03/10/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38,49,50,47,129,147,155**;9/30/97;Build 36
+2 ;
+3 ;Reference to PS(50.607 supported by DBIA 2221
DOSN ;
+1 NEW X,Y,PSSNFID,PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNOCON,PSSST,PSSUN,PSSNAME,PSSIND,PSSDOSA,PSSXYZ,PSSNATST,POSDOS,LPDOS
+2 NEW PSSDIEN,PSSONLYI,PSSONLYO,PSSTALK,PSSIZZ,PSSOZZ,PSSSKIPP,PSSWDXF
+3 NEW PSSUPRA,PSSIEN
SET PSSIEN=DA
DOSNX ;
+1 DO STUN
+2 IF PSSST=""
IF $ORDER(^PSDRUG(PSSIEN,"DOS1",0))
KILL ^PSDRUG(PSSIEN,"DOS")
KILL ^PSDRUG(PSSIEN,"DOS1")
+3 SET (PSSIZZ,PSSOZZ)=0
if '$GET(PSSSKIPP)
SET PSSSKIPP=0
+4 SET PSSXYZ=0
DO CHECK
+5 ;Display strength
+6 if $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")'=""
DO XNWS
+7 IF PSSXYZ
IF PSSUPRA="NN"
if $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")=""
DO XNW
GOTO DOSA
+8 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")'=""
IF $ORDER(^PSDRUG(PSSIEN,"DOS1",0))
NEW PSSIENS,PSS11
GOTO DOSA
+9 ;.N PSSDESTP W !!,"Strength from National Drug File match => "_$S($E($G(PSSNATST),1)=".":"0",1:"")_$G(PSSNATST)_" "_$P($G(^PS(50.607,+$G(PSSUN),0)),"^")
+10 ;.W !,"Strength currently in the Drug File => "_$S($E($P($G(^PSDRUG(PSSIEN,"DOS")),"^"),1)=".":"0",1:"")_$P($G(^PSDRUG(PSSIEN,"DOS")),"^")_" "_$S($P($G(^PS(50.607,+$G(PSSUN),0)),"^")'["/":$P($G(^(0)),"^"),1:"") S PSSDESTP=1 D MS^PSSDSPOP
+11 ;.K PSSDESTP
+12 ;
+13 IF $GET(PSSXYZ)
IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
Begin DoDot:1
+14 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Create Possible Dosages for this drug"
SET DIR("?")=" "
+15 SET DIR("?",1)="This drug meets the criteria to have Possible Dosages, but it currently does"
SET DIR("?",2)="not have any. If you answer 'YES', Possible Dosages will be created for this"
+16 SET DIR("?",3)="drug, based on the match to the National Drug File."
+17 WRITE !!,"This drug can have Possible Dosages, but currently does not have any.",!
+18 IF $GET(PSSUPRAF)=2
IF (PSSUPRA="NO"!(PSSUPRA="NB"))
WRITE !,"This drug has been set within the National Drug File to auto create "_$SELECT(PSSUPRA="NO":"only one ",PSSUPRA="NB":"two ",1:""),!,"possible dosage"_$SELECT(PSSUPRA="NO":".",1:"s."),!
End DoDot:1
DO ^DIR
KILL DIR
IF Y=1
SET PSSSKIPP=1
DO EN2^PSSUTIL(PSSIEN,1)
GOTO DOSNX
+19 IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
DO LPD
DO QUES
if 'Y
GOTO END
GOTO LOCX
DOSA SET PSSST=$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")
SET PSSWDXF=0
+1 WRITE !!,"Strength => "_$SELECT($EXTRACT($GET(PSSST),1)=".":"0",1:"")_$GET(PSSST)_" Unit => "_$SELECT($PIECE($GET(^PS(50.607,+$GET(PSSUN),0)),"^")'["/":$PIECE($GET(^(0)),"^"),1:"")
WRITE !
+2 ;;;I $D(^PSDRUG(PSSIEN,"DOS1"))
+3 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
GOTO WXF
WRITE !,"POSSIBLE DOSAGES:"
Begin DoDot:1
+4 FOR PDS=0:0
SET PDS=$ORDER(^PSDRUG(PSSIEN,"DOS1",PDS))
if 'PDS!(PSSWDXF)
QUIT
Begin DoDot:2
+5 SET POSDOS=$GET(^PSDRUG(PSSIEN,"DOS1",PDS,0))
+6 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
WRITE !," DISPENSE UNITS PER DOSE: ",$SELECT($EXTRACT($PIECE(POSDOS,U),1)=".":"0",1:"")_$PIECE(POSDOS,U)
Begin DoDot:3
+7 SET X=$PIECE(POSDOS,U)
DO SET^PSSDOSLZ
WRITE ?38,"DOSE: ",X,?60,"PACKAGE: ",$PIECE(POSDOS,U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+8 ;;;I $D(^PSDRUG(PSSIEN,"DOS2"))
+9 SET PSSWDXF=0
WRITE !!,"LOCAL POSSIBLE DOSAGES:"
Begin DoDot:1
+10 FOR PDS=0:0
SET PDS=$ORDER(^PSDRUG(PSSIEN,"DOS2",PDS))
if 'PDS!(PSSWDXF)
QUIT
Begin DoDot:2
+11 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
SET LPDOS=$GET(^PSDRUG(PSSIEN,"DOS2",PDS,0))
WRITE !," LOCAL POSSIBLE DOSAGE: "
Begin DoDot:3
+12 IF $LENGTH($PIECE(LPDOS,U))'>27
WRITE $PIECE(LPDOS,U),?55,"PACKAGE: ",$PIECE(LPDOS,U,2)
DO WXFPT(LPDOS)
QUIT
+13 WRITE !,?10,$PIECE(LPDOS,U),!,?55,"PACKAGE: ",$PIECE(LPDOS,U,2)
DO WXFPT(LPDOS)
End DoDot:3
End DoDot:2
End DoDot:1
WXF ;
+1 IF $$CHECK^PSSUTIL3(PSSIEN)
IF ($GET(PSSUPRAF)'=2)
Begin DoDot:1
+2 IF PSSUPRA="NN"
WRITE !!,"Due to National Drug File settings no possible dosages were auto-created."
+3 IF PSSUPRA="NO"
WRITE !!,"Due to National Drug File settings only ONE possible dosage was auto-created.",!,"If other dosages are needed, create POSSIBLE DOSAGES or LOCAL POSSIBLE DOSAGES",!,"as appropriate."
+4 IF PSSUPRA="NB"
WRITE !!,"Due to National Drug File settings TWO possible dosages were auto-created."
End DoDot:1
+5 IF $EXTRACT(PSSUPRA)="N"
IF ($GET(PSSUPRAF)=2)
Begin DoDot:1
+6 IF PSSUPRA["N"
WRITE !!,"This drug has been set within the National Drug File to "_$SELECT(PSSUPRA="NN":"not ",1:"")_"auto create "_$SELECT(PSSUPRA="NO":"only one ",PSSUPRA="NB":"two ",1:""),!,"possible dosage"_$SELECT(PSSUPRA="NO":".",1:"s.")
+7 SET DIR("?",1)="This drug meets the criteria to have Possible Dosages, but it currently does"
SET DIR("?",2)="not have any. If you answer 'YES', Possible Dosages will be created for this"
+8 SET DIR("?",3)="drug, based on the match to the National Drug File."
End DoDot:1
+9 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to "_$SELECT(PSSUPRA="NN"&('$ORDER(^PSDRUG(PSSIEN,"DOS1",0))):"manually enter possible",1:"edit the")_" dosages"
SET DIR("B")="N"
+10 IF $GET(PSSXYZ)
IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
IF $EXTRACT(PSSUPRA)="N"
Begin DoDot:1
+11 SET DIR("?")=" "
SET DIR("?",1)="This drug meets the criteria to have Possible Dosages, but it currently does"
SET DIR("?",2)="not have any. If you answer 'YES', Possible Dosages can be manually entered for this drug."
End DoDot:1
+12 DO ^DIR
KILL DIR
IF 'Y
WRITE !
DO END
QUIT
+13 IF $GET(PSSST)
WRITE !!,"Changing the strength will update all possible dosages for this Drug.",!
+14 ;Edit Strength
+15 IF $GET(PSSST)
WRITE !
KILL DIE
SET DIE="^PSDRUG("
SET DA=PSSIEN
SET DR=901
DO ^DIE
WRITE !
KILL DIE,PSSXYZ
IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")=""
KILL ^PSDRUG(PSSIEN,"DOS")
KILL ^PSDRUG(PSSIEN,"DOS1")
WRITE !!,"Deleting Strength has deleted all Possible Dosages!",!
+16 IF '$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")
DO LPD
DO QUES
if 'Y
GOTO END
GOTO LOC
+17 ;
DOSA1 KILL DIC
SET DA(1)=PSSIEN
SET DIC="^PSDRUG("_PSSIEN_",""DOS1"","
SET DIC(0)="QEAMLZ"
SET DIC("A")="Select DISPENSE UNITS PER DOSE: "
Begin DoDot:1
+1 SET DIC("W")="W "" ""_$S($E($P($G(^PSDRUG(PSSIEN,""DOS1"",+Y,0)),""^"",2),1)=""."":""0"",1:"""")_$P($G(^PSDRUG(PSSIEN,""DOS1"",+Y,0)),""^"",2)_"" ""_$P($G(^PSDRUG(PSSIEN,""DOS1"",+Y,0)),""^"",3)"
End DoDot:1
DO ^DIC
KILL DIC
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
GOTO DOSLOC
+2 SET PSSDOSA=+Y
+3 WRITE !
KILL DIE
SET DA(1)=PSSIEN
SET DA=PSSDOSA
SET DR=".01;2"
SET DIE="^PSDRUG("_PSSIEN_",""DOS1"","
DO ^DIE
KILL DIE
if '$DATA(Y)&('$DATA(DTOUT))
DO BCMA^PSSDOSER
if $DATA(Y)!($DATA(DTOUT))
GOTO DOSLOC
+4 WRITE !
GOTO DOSA1
DOSLOC ;
+1 SET (PSSPCI,PSSPCO)=0
+2 FOR PSSPCZ=0:0
SET PSSPCZ=$ORDER(^PSDRUG(PSSIEN,"DOS1",PSSPCZ))
if 'PSSPCZ
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS1",PSSPCZ,0)),"^",2)'=""
if $PIECE($GET(^(0)),"^",3)["I"
SET PSSPCI=1
if $PIECE($GET(^(0)),"^",3)["O"
SET PSSPCO=1
End DoDot:1
+4 IF PSSPCI
IF PSSPCO
WRITE !!
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Enter/Edit Local Possible Dosages"
Begin DoDot:1
+5 SET DIR("?")=" "
SET DIR("?",1)="Possible Dosages exist for both Outpatient Pharmacy and Inpatient Medications."
SET DIR("?",2)="Local Possible Dosages can be added, but will not be displayed for selection"
+6 SET DIR("?",3)="as long as there are Possible Dosages."
SET DIR("?",4)=" "
SET DIR("?",5)="Enter 'Y' to Enter/Edit Local Possible Dosages."
End DoDot:1
DO ^DIR
KILL DIR
IF Y'=1
KILL PSSPCI,PSSPCO,PSSPCZ
WRITE !
DO END
QUIT
+7 KILL PSSPCI,PSSPCO,PSSPCZ
+8 ;
LOCX ;
+1 IF $GET(PSSSKIPP)
GOTO LOC
+2 IF $GET(PSSIZZ)
IF $GET(PSSOZZ)
GOTO LOC
+3 KILL PSSONLYO,PSSONLYI
+4 IF $GET(PSSIZZ)
IF '$GET(PSSOZZ)
SET PSSONLYO=1
+5 IF $GET(PSSOZZ)
IF '$GET(PSSIZZ)
SET PSSONLYI=1
+6 SET PSSTALK=1
SET PSSDIEN=PSSIEN
DO LOC^PSSUTIL
KILL PSSONLYI,PSSONLYO,PSSTALK,PSSDIEN
LOC ; Edit local dose
+1 DO STUN
DO NATND
DO PR
+2 WRITE !
KILL DIC
SET DA(1)=PSSIEN
SET DIC="^PSDRUG("_PSSIEN_",""DOS2"","
SET DIC(0)="QEAMLZ"
Begin DoDot:1
+3 SET DIC("W")="W "" ""_$P($G(^PSDRUG(PSSIEN,""DOS2"",+Y,0)),""^"",2)"
End DoDot:1
DO ^DIC
KILL DIC
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
DO END
QUIT
+4 SET PSSDOSA=+Y
SET PSSOTH=$SELECT($PIECE($GET(^PS(59.7,1,40.2)),"^"):1,1:0)
+5 WRITE !
KILL DIE
SET DA(1)=PSSIEN
SET DA=PSSDOSA
SET DR=".01;S:'$G(PSSOTH) Y=""@1"";3;@1;1"
SET DIE="^PSDRUG("_PSSIEN_",""DOS2"","
+6 DO ^DIE
KILL DIE,PSSOTH
if $PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSDOSA,0)),"^")=""
GOTO LOC
if '$DATA(Y)&('$DATA(DTOUT))
DO BCMA1^PSSDOSER
IF $DATA(Y)!($DATA(DTOUT))
DO END
QUIT
+7 IF $$TEST^PSSDSPOP(PSSIEN)
KILL DA,DIE,DR,DIDEL
SET DA(1)=PSSIEN
SET DA=PSSDOSA
SET DR="4;5"
SET DIE="^PSDRUG("_PSSIEN_",""DOS2"","
DO ^DIE
KILL DIE,DA,DR,DIDEL
IF $DATA(Y)!($DATA(DTOUT))
DO END
QUIT
+8 GOTO LOC
LPD ; Display local dose before edit
+1 SET PSSWDXF=0
if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
WRITE !!,"LOCAL POSSIBLE DOSAGES:"
Begin DoDot:1
+2 FOR PDS=0:0
SET PDS=$ORDER(^PSDRUG(PSSIEN,"DOS2",PDS))
if 'PDS!(PSSWDXF)
QUIT
Begin DoDot:2
+3 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
SET LPDOS=$GET(^PSDRUG(PSSIEN,"DOS2",PDS,0))
WRITE !," "
Begin DoDot:3
+4 IF $LENGTH($PIECE(LPDOS,U))'>27
WRITE $PIECE(LPDOS,U),?55,"PACKAGE: ",$PIECE(LPDOS,U,2)
DO WXFPT(LPDOS)
QUIT
+5 WRITE !,?10,$PIECE(LPDOS,U),!,?55,"PACKAGE: ",$PIECE(LPDOS,U,2)
DO WXFPT(LPDOS)
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
CHECK ;
+1 KILL PSSUPRA,PSSNAT,PSSNATND,PSSNATDF,PSSNATUN,PSSNATST,PSSIZZ,PSSOZZ
+2 DO NATND
+3 ;I $G(PSSST) S PSSXYZ=1 Q
+4 if 'PSSNATDF!('PSSNATUN)!($GET(PSSNATST)="")
QUIT
+5 if '$DATA(^PS(50.606,PSSNATDF,0))!('$DATA(^PS(50.607,PSSNATUN,0)))
QUIT
+6 IF PSSNATST'?.N&(PSSNATST'?.N1".".N)
QUIT
+7 IF $DATA(^PS(50.606,"ACONI",PSSNATDF,PSSNATUN))
IF $ORDER(^PS(50.606,"ADUPI",PSSNATDF,0))
SET (PSSXYZ,PSSIZZ)=1
+8 IF $DATA(^PS(50.606,"ACONO",PSSNATDF,PSSNATUN))
IF $ORDER(^PS(50.606,"ADUPO",PSSNATDF,0))
SET (PSSXYZ,PSSOZZ)=1
+9 QUIT
END KILL PSSNFID,PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNOCON,PSSST,PSSUN,PSSIEN,PSSNAME,PSSIND,PSSDOSA,PSSXYZ,PSSNATST
+1 QUIT
ULK ;No need to unlock, called from Drug enter/edit
+1 if '$GET(PSSIEN)
QUIT
+2 LOCK -^PSDRUG(PSSIEN)
+3 QUIT
QUES ;
+1 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to edit Local Possible Dosages"
SET DIR("B")="N"
DO ^DIR
KILL DIR
QUIT
+2 QUIT
STUN SET PSSST=$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")
SET PSSUN=$PIECE($GET(^("DOS")),"^",2)
+1 QUIT
NATND SET PSSNAT=+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^",3)
SET PSSNAT1=$PIECE($GET(^("ND")),"^")
+1 SET PSSNATND=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT)
SET PSSNATDF=$PIECE(PSSNATND,"^")
SET PSSNATST=$PIECE(PSSNATND,"^",4)
SET PSSNATUN=$PIECE(PSSNATND,"^",5)
+2 SET PSSUPRA=$$SUPRA^PSSUTIL3(PSSNAT)
+3 QUIT
PR IF PSSST'=""!(PSSNATST'="")
IF (PSSUN!(PSSNATUN))
Begin DoDot:1
+1 WRITE !!,"Strength: "_$SELECT($EXTRACT($SELECT(PSSST'="":PSSST,1:PSSNATST),1)=".":"0",1:"")_$SELECT(PSSST'="":PSSST,1:PSSNATST)
+2 WRITE ?30,"Unit: "_$PIECE($GET(^PS(50.607,+$SELECT(PSSUN:PSSUN,1:PSSNATUN),0)),"^")
End DoDot:1
+3 IF '$TEST
WRITE !!,"Strength: ",?30,"Unit: "
+4 QUIT
XNW ;
+1 IF $PIECE(^PSDRUG(PSSIEN,"ND"),"^",2)]""
IF ('$DATA(^PSDRUG(PSSIEN,"DOS")))
SET ^PSDRUG(PSSIEN,"DOS")=PSSNATST_"^"_PSSNATUN
XNWS ;
+1 NEW PSSDESTP
WRITE !!,"Strength from National Drug File match => "_$SELECT($EXTRACT($GET(PSSNATST),1)=".":"0",1:"")_$GET(PSSNATST)_" "_$PIECE($GET(^PS(50.607,+$GET(PSSUN),0)),"^")
+2 WRITE !,"Strength currently in the Drug File => "_$SELECT($EXTRACT($PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^"),1)=".":"0",1:"")_$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")_" "_$SELECT($PIECE($GET(^PS(50.607,+...
... $GET(PSSUN),0)),"^")'["/":$PIECE($GET(^(0)),"^"),1:"")
SET PSSDESTP=1
DO MS^PSSDSPOP
+3 KILL PSSDESTP
+4 QUIT
+5 ;
+6 ;
QASK ;Ask to continue
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 KILL DIR
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue,'^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSWDXF=1
+3 WRITE @IOF
+4 QUIT
+5 ;
+6 ;
WXFPT(PSSWDXVL) ;Add print fields with PSS*1*147
+1 NEW PSSWDX1,PSSWDX2,PSSWDX3,PSSWDX4,PSSWDX5,PSSWDX6
+2 SET PSSWDX4=""
+3 SET PSSWDX1=$PIECE(PSSWDXVL,"^",3)
SET PSSWDX2=$PIECE(PSSWDXVL,"^",5)
SET PSSWDX3=$PIECE(PSSWDXVL,"^",6)
+4 IF PSSWDX2
SET PSSWDX4=$PIECE($GET(^PS(51.24,+PSSWDX2,0)),"^")
+5 SET PSSWDX5=$SELECT($EXTRACT(PSSWDX3)=".":"0",1:"")_PSSWDX3
+6 SET PSSWDX6=$LENGTH(PSSWDX5)
+7 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
WRITE !?4,"BCMA UNITS PER DOSE: "_PSSWDX1
+8 IF PSSWDX6<12
if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
WRITE !?4," NUMERIC DOSE: "_PSSWDX5,?38,"DOSE UNIT: "_PSSWDX4
QUIT
+9 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
WRITE !,?4," NUMERIC DOSE: "_PSSWDX5
+10 if ($Y+5)>IOSL
DO QASK
if PSSWDXF
QUIT
WRITE !,?38,"DOSE UNIT: "_PSSWDX4
+11 QUIT
