PSSDOSER ;BIR/RTR-Dose edit option ; 21 Sep 2015 8:37 PM
;;1.0;PHARMACY DATA MANAGEMENT;**34,38,50,57,47,68,82,125,129,144,155,194**;9/30/97;Build 9
;Reference to ^PS(50.607 supported by DBIA #2221
;Reference to ^PS(59 supported by DBIA #1976
;
;have an entry point for NDF to call when rematching
DOS ;Edit dosages
D CHECK^PSSUTLPR I $G(PSSNOCON) K PSSNOCON D END Q
D END
W !! S DIC(0)="QEAMZ",DIC("A")="Select Drug: ",DIC="^PSDRUG(" D ^DIC K DIC I Y<1!($D(DTOUT))!($D(DUOUT)) D END W ! Q
S PSSIEN=+Y,PSSNAME=$P($G(^PSDRUG(PSSIEN,0)),"^"),PSSIND=$P($G(^("I")),"^"),PSSNFID=$P($G(^(0)),"^",9)
S PSSPKG=$P($G(^PSDRUG(PSSIEN,2)),"^",3)
W !!,"This entry is marked for the following PHARMACY packages:"
W:PSSPKG["O" !,"Outpatient" W:PSSPKG["U" !,"Unit Dose"
W:PSSPKG["I" !,"IV" W:PSSPKG["W" !,"Ward Stock"
W:PSSPKG["N" !,"Controlled Substances" W:PSSPKG["X" !,"Non-VA Med"
I PSSPKG'["O",PSSPKG'["U",PSSPKG'["I",PSSPKG'["W",PSSPKG'["N",PSSPKG'["X" W !," (none)"
K PSSPKG L +^PSDRUG(PSSIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T W !!,$C(7),"Another person is editing this drug.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR G DOS
W !!,PSSNAME_$S($G(PSSNFID):" *N/F*",1:"") W ?52,"Inactive Date: "_$S($G(PSSIND):$E(PSSIND,4,5)_"/"_$E(PSSIND,6,7)_"/"_$E(PSSIND,2,3),1:"")
S (PSSIZZ,PSSOZZ,PSSSKIPP)=0
RES ;
D STUN
I PSSST="",$O(^PSDRUG(PSSIEN,"DOS1",0)) K ^PSDRUG(PSSIEN,"DOS") K ^PSDRUG(PSSIEN,"DOS1")
S PSSXYZ=0 D CHECK
I PSSXYZ,PSSUPRA="NN" D MPD K:$D(PSSZ) PSSZ Q
D:$G(PSSST) XNWS I $G(PSSST),$O(^PSDRUG(PSSIEN,"DOS1",0)) D STR G SKIP
I PSSXYZ,'$O(^PSDRUG(PSSIEN,"DOS1",0)) D D ^DIR K DIR I Y=1 S PSSSKIPP=1 D EN2^PSSUTIL(PSSIEN,1) G RES
.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 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."),!
.W !
SKIP ;
K PSSXYZ,PSSZ
I '$O(^PSDRUG(PSSIEN,"DOS1",0)) G LOCX
DOSA S PSSST=$P($G(^PSDRUG(PSSIEN,"DOS")),"^")
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 PSSUPRA["N",'PSSSKIPP,'$G(PSSZ) S PSSZ=1 D
.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."),!
K DIC S DA(1)=PSSIEN,DIC="^PSDRUG("_PSSIEN_",""DOS1"",",DIC(0)="QEAMLZ",DLAYGO=50,DIC("A")="Select DISPENSE UNITS PER DOSE: " D D ^DIC K DIC,DLAYGO 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,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"";@1;2",DIE="^PSDRUG("_PSSIEN_",""DOS1""," D ^DIE K DIE D:'$D(Y)&('$D(DTOUT)) BCMA G:$D(Y)!($D(DTOUT)) DOSLOC ;;<*144 - RJS
G DOSA
DOSLOC ;
S (PSSPCI,PSSPCO)=0 K:$D(PSSZ) PSSZ
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 ULK G DOS
.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 PSSONLYI,PSSONLYO
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 PSSONLYO,PSSONLYI,PSSTALK,PSSDIEN
;MAKE SURE THOSE ARE THE VARIABLES YOU NEED TO SET
LOC ; Edit local dose
D STUN,NATND,PR
W ! K DIC S DA(1)=PSSIEN,DIC="^PSDRUG("_PSSIEN_",""DOS2"",",DLAYGO=50,DIC(0)="QEAMLZ" D D ^DIC K DIC,DLAYGO I Y<1!($D(DTOUT))!($D(DUOUT)) D ULK G DOS
.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
I $P($G(^PSDRUG(PSSIEN,"DOS2",PSSDOSA,0)),"^")="" G LOC
D:'$D(Y)&('$D(DTOUT)) BCMA1 I $D(Y)!($D(DTOUT)) D ULK G DOS
I '$D(Y)&('$D(DTOUT)),$$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 ULK G DOS
G LOC
Q
STR ;Edit strength
N PSSIENS,PSS11
;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:"") D MS^PSSDSPOP
W ! K DIR S DIR(0)="Y",DIR("?")="Changing the strength will update all possible dosages for this Drug",DIR("B")="NO",DIR("A")="Edit Strength" D ^DIR K DIR I 'Y W ! Q
W !!,"Changing the strength will not change the concentration."
W ! K DIR S DIR(0)="Y"
S DIR("?")="Changes in strength do not cause changes in concentration."
S DIR("B")="NO",DIR("A")="Are you sure you need to change the strength" D ^DIR K DIR I 'Y W ! Q
W ! K DIE S DIE="^PSDRUG(",DA=PSSIEN,DR=901 D ^DIE K DIE W !
I $P($G(^PSDRUG(PSSIEN,"DOS")),"^")="" K ^PSDRUG(PSSIEN,"DOS") K ^PSDRUG(PSSIEN,"DOS1") W !!,"Deleting Strength has deleted all Possible Dosages!",!
Q
CHECK ;
K PSSNAT,PSSNATND,PSSNATDF,PSSNATUN,PSSNATST,PSSIZZ,PSSOZZ
S PSSNAT=+$P($G(^PSDRUG(PSSIEN,"ND")),"^",3),PSSNAT1=$P($G(^("ND")),"^") I 'PSSNAT!('PSSNAT1) Q
S PSSNATND=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT) S PSSNATDF=$P(PSSNATND,"^"),PSSNATST=$P(PSSNATND,"^",4),PSSNATUN=$P(PSSNATND,"^",5)
S PSSUPRA=$$SUPRA^PSSUTIL3(PSSNAT)
;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 PSSIZZ,PSSOZZ,PSSSKIPP,PSSNFID,PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNOCON,PSSST,PSSUN,PSSIEN,PSSNAME,PSSIND,PSSDOSA,PSSXYZ,PSSNATST
Q
ULK ;
Q:'$G(PSSIEN)
N XX,DNSNAM,DNSPORT,DVER,DMFU S XX=""
I '$G(PSSHUIDG) D DRG^PSSHUIDG(PSSIEN) D
.F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D
..S DVER=$$GET1^DIQ(59,XX_",",105,"I"),DMFU=$$GET1^DIQ(59,XX_",",105.2)
..I DVER="2.4" S DNSNAM=$$GET1^DIQ(59,XX_",",2006),DNSPORT=$$GET1^DIQ(59,XX_",",2007) I DNSNAM'=""&(DMFU="YES") D DRG^PSSDGUPD(PSSIEN,"",DNSNAM,DNSPORT)
L -^PSDRUG(PSSIEN)
Q
BCMA ;
I $P($G(^PSDRUG(PSSIEN,2)),"^",3)'["I",$P($G(^(2)),"^",3)'["U" Q
I $P($G(^PSDRUG(PSSIEN,"DOS1",PSSDOSA,0)),"^",3)'["I" Q
K DIE S DA(1)=PSSIEN,DA=PSSDOSA,DR=3,DIE="^PSDRUG("_PSSIEN_",""DOS1""," D ^DIE K DIE
Q
BCMA1 ;
I $P($G(^PSDRUG(PSSIEN,2)),"^",3)'["I",$P($G(^(2)),"^",3)'["U" Q
I $P($G(^PSDRUG(PSSIEN,"DOS2",PSSDOSA,0)),"^",2)'["I" Q
K DIE S DA(1)=PSSIEN,DA=PSSDOSA,DR=2,DIE="^PSDRUG("_PSSIEN_",""DOS2""," D ^DIE K DIE
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)
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
;
;
XNWS ;
N PSSDESTP S PSSDESTP=1
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:"") D MS^PSSDSPOP
K PSSDESTP
Q
MPD ; manually enter poosible dosage
I $P($G(^PSDRUG(PSSIEN,"DOS")),"^")="" S:$P(^PSDRUG(PSSIEN,"ND"),"^",2)]"" ^PSDRUG(PSSIEN,"DOS")=PSSNATST_"^"_PSSNATUN
I PSSXYZ,'$O(^PSDRUG(PSSIEN,"DOS1",0)) D D ^DIR K DIR I 'Y W ! K PSSXYZ K:$D(PSSZ) PSSZ I '$O(^PSDRUG(PSSIEN,"DOS1",0)) G LOCX Q
.K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to manually enter possible dosages",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 can be manually entered for this drug."
.W !!!,"This drug can have Possible Dosages, but currently does not have any.",!
.S PSSZ=1 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."),!
D XNWS,STR,DOSA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDOSER 10106 printed Oct 16, 2024@18:31:40 Page 2
PSSDOSER ;BIR/RTR-Dose edit option ; 21 Sep 2015 8:37 PM
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,50,57,47,68,82,125,129,144,155,194**;9/30/97;Build 9
+2 ;Reference to ^PS(50.607 supported by DBIA #2221
+3 ;Reference to ^PS(59 supported by DBIA #1976
+4 ;
+5 ;have an entry point for NDF to call when rematching
DOS ;Edit dosages
+1 DO CHECK^PSSUTLPR
IF $GET(PSSNOCON)
KILL PSSNOCON
DO END
QUIT
+2 DO END
+3 WRITE !!
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Drug: "
SET DIC="^PSDRUG("
DO ^DIC
KILL DIC
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
DO END
WRITE !
QUIT
+4 SET PSSIEN=+Y
SET PSSNAME=$PIECE($GET(^PSDRUG(PSSIEN,0)),"^")
SET PSSIND=$PIECE($GET(^("I")),"^")
SET PSSNFID=$PIECE($GET(^(0)),"^",9)
+5 SET PSSPKG=$PIECE($GET(^PSDRUG(PSSIEN,2)),"^",3)
+6 WRITE !!,"This entry is marked for the following PHARMACY packages:"
+7 if PSSPKG["O"
WRITE !,"Outpatient"
if PSSPKG["U"
WRITE !,"Unit Dose"
+8 if PSSPKG["I"
WRITE !,"IV"
if PSSPKG["W"
WRITE !,"Ward Stock"
+9 if PSSPKG["N"
WRITE !,"Controlled Substances"
if PSSPKG["X"
WRITE !,"Non-VA Med"
+10 IF PSSPKG'["O"
IF PSSPKG'["U"
IF PSSPKG'["I"
IF PSSPKG'["W"
IF PSSPKG'["N"
IF PSSPKG'["X"
WRITE !," (none)"
+11 KILL PSSPKG
LOCK +^PSDRUG(PSSIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE !!,$CHAR(7),"Another person is editing this drug.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
GOTO DOS
+12 WRITE !!,PSSNAME_$SELECT($GET(PSSNFID):" *N/F*",1:"")
WRITE ?52,"Inactive Date: "_$SELECT($GET(PSSIND):$EXTRACT(PSSIND,4,5)_"/"_$EXTRACT(PSSIND,6,7)_"/"_$EXTRACT(PSSIND,2,3),1:"")
+13 SET (PSSIZZ,PSSOZZ,PSSSKIPP)=0
RES ;
+1 DO STUN
+2 IF PSSST=""
IF $ORDER(^PSDRUG(PSSIEN,"DOS1",0))
KILL ^PSDRUG(PSSIEN,"DOS")
KILL ^PSDRUG(PSSIEN,"DOS1")
+3 SET PSSXYZ=0
DO CHECK
+4 IF PSSXYZ
IF PSSUPRA="NN"
DO MPD
if $DATA(PSSZ)
KILL PSSZ
QUIT
+5 if $GET(PSSST)
DO XNWS
IF $GET(PSSST)
IF $ORDER(^PSDRUG(PSSIEN,"DOS1",0))
DO STR
GOTO SKIP
+6 IF PSSXYZ
IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
Begin DoDot:1
+7 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Create Possible Dosages for this drug"
SET DIR("?")=" "
+8 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"
+9 SET DIR("?",3)="drug, based on the match to the National Drug File."
+10 WRITE !!!,"This drug can have Possible Dosages, but currently does not have any.",!
+11 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."),
!
+12 WRITE !
End DoDot:1
DO ^DIR
KILL DIR
IF Y=1
SET PSSSKIPP=1
DO EN2^PSSUTIL(PSSIEN,1)
GOTO RES
SKIP ;
+1 KILL PSSXYZ,PSSZ
+2 IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
GOTO LOCX
DOSA SET PSSST=$PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")
+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 IF PSSUPRA["N"
IF 'PSSSKIPP
IF '$GET(PSSZ)
SET PSSZ=1
Begin DoDot:1
+3 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."),
!
End DoDot:1
+4 KILL DIC
SET DA(1)=PSSIEN
SET DIC="^PSDRUG("_PSSIEN_",""DOS1"","
SET DIC(0)="QEAMLZ"
SET DLAYGO=50
SET DIC("A")="Select DISPENSE UNITS PER DOSE: "
Begin DoDot:1
+5 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,DLAYGO
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
GOTO DOSLOC
+6 SET PSSDOSA=+Y
SET PSSOTH=$SELECT($PIECE($GET(^PS(59.7,1,40.2)),"^"):1,1:0)
+7 ;;<*144 - RJS
WRITE !
KILL DIE
SET DA(1)=PSSIEN
SET DA=PSSDOSA
SET DR=".01;S:'$G(PSSOTH) Y=""@1"";@1;2"
SET DIE="^PSDRUG("_PSSIEN_",""DOS1"","
DO ^DIE
KILL DIE
if '$DATA(Y)&('$DATA(DTOUT))
DO BCMA
if $DATA(Y)!($DATA(DTOUT))
GOTO DOSLOC
+8 GOTO DOSA
DOSLOC ;
+1 SET (PSSPCI,PSSPCO)=0
if $DATA(PSSZ)
KILL PSSZ
+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 ULK
GOTO DOS
+7 KILL PSSPCI,PSSPCO,PSSPCZ
LOCX ;
+1 IF $GET(PSSSKIPP)
GOTO LOC
+2 IF $GET(PSSIZZ)
IF $GET(PSSOZZ)
GOTO LOC
+3 KILL PSSONLYI,PSSONLYO
+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 PSSONLYO,PSSONLYI,PSSTALK,PSSDIEN
+7 ;MAKE SURE THOSE ARE THE VARIABLES YOU NEED TO SET
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 DLAYGO=50
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,DLAYGO
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
DO ULK
GOTO DOS
+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"","
DO ^DIE
KILL DIE,PSSOTH
+6 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSDOSA,0)),"^")=""
GOTO LOC
+7 if '$DATA(Y)&('$DATA(DTOUT))
DO BCMA1
IF $DATA(Y)!($DATA(DTOUT))
DO ULK
GOTO DOS
+8 IF '$DATA(Y)&('$DATA(DTOUT))
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 ULK
GOTO DOS
+9 GOTO LOC
+10 QUIT
STR ;Edit strength
+1 NEW PSSIENS,PSS11
+2 ;W !!,"Strength from National Drug File match => "_$S($E($G(PSSNATST),1)=".":"0",1:"")_$G(PSSNATST)_" "_$P($G(^PS(50.607,+$G(PSSUN),0)),"^")
+3 ;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:"") D MS^PSSDSPOP
+4 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("?")="Changing the strength will update all possible dosages for this Drug"
SET DIR("B")="NO"
SET DIR("A")="Edit Strength"
DO ^DIR
KILL DIR
IF 'Y
WRITE !
QUIT
+5 WRITE !!,"Changing the strength will not change the concentration."
+6 WRITE !
KILL DIR
SET DIR(0)="Y"
+7 SET DIR("?")="Changes in strength do not cause changes in concentration."
+8 SET DIR("B")="NO"
SET DIR("A")="Are you sure you need to change the strength"
DO ^DIR
KILL DIR
IF 'Y
WRITE !
QUIT
+9 WRITE !
KILL DIE
SET DIE="^PSDRUG("
SET DA=PSSIEN
SET DR=901
DO ^DIE
KILL DIE
WRITE !
+10 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")=""
KILL ^PSDRUG(PSSIEN,"DOS")
KILL ^PSDRUG(PSSIEN,"DOS1")
WRITE !!,"Deleting Strength has deleted all Possible Dosages!",!
+11 QUIT
CHECK ;
+1 KILL PSSNAT,PSSNATND,PSSNATDF,PSSNATUN,PSSNATST,PSSIZZ,PSSOZZ
+2 SET PSSNAT=+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^",3)
SET PSSNAT1=$PIECE($GET(^("ND")),"^")
IF 'PSSNAT!('PSSNAT1)
QUIT
+3 SET PSSNATND=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT)
SET PSSNATDF=$PIECE(PSSNATND,"^")
SET PSSNATST=$PIECE(PSSNATND,"^",4)
SET PSSNATUN=$PIECE(PSSNATND,"^",5)
+4 SET PSSUPRA=$$SUPRA^PSSUTIL3(PSSNAT)
+5 ;I $G(PSSST) S PSSXYZ=1 Q
+6 if 'PSSNATDF!('PSSNATUN)!($GET(PSSNATST)="")
QUIT
+7 if '$DATA(^PS(50.606,PSSNATDF,0))!('$DATA(^PS(50.607,PSSNATUN,0)))
QUIT
+8 IF PSSNATST'?.N&(PSSNATST'?.N1".".N)
QUIT
+9 IF $DATA(^PS(50.606,"ACONI",PSSNATDF,PSSNATUN))
IF $ORDER(^PS(50.606,"ADUPI",PSSNATDF,0))
SET (PSSXYZ,PSSIZZ)=1
+10 IF $DATA(^PS(50.606,"ACONO",PSSNATDF,PSSNATUN))
IF $ORDER(^PS(50.606,"ADUPO",PSSNATDF,0))
SET (PSSXYZ,PSSOZZ)=1
+11 QUIT
END KILL PSSIZZ,PSSOZZ,PSSSKIPP,PSSNFID,PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNOCON,PSSST,PSSUN,PSSIEN,PSSNAME,PSSIND,PSSDOSA,PSSXYZ,PSSNATST
+1 QUIT
ULK ;
+1 if '$GET(PSSIEN)
QUIT
+2 NEW XX,DNSNAM,DNSPORT,DVER,DMFU
SET XX=""
+3 IF '$GET(PSSHUIDG)
DO DRG^PSSHUIDG(PSSIEN)
Begin DoDot:1
+4 FOR XX=0:0
SET XX=$ORDER(^PS(59,XX))
if 'XX
QUIT
Begin DoDot:2
+5 SET DVER=$$GET1^DIQ(59,XX_",",105,"I")
SET DMFU=$$GET1^DIQ(59,XX_",",105.2)
+6 IF DVER="2.4"
SET DNSNAM=$$GET1^DIQ(59,XX_",",2006)
SET DNSPORT=$$GET1^DIQ(59,XX_",",2007)
IF DNSNAM'=""&(DMFU="YES")
DO DRG^PSSDGUPD(PSSIEN,"",DNSNAM,DNSPORT)
End DoDot:2
End DoDot:1
+7 LOCK -^PSDRUG(PSSIEN)
+8 QUIT
BCMA ;
+1 IF $PIECE($GET(^PSDRUG(PSSIEN,2)),"^",3)'["I"
IF $PIECE($GET(^(2)),"^",3)'["U"
QUIT
+2 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS1",PSSDOSA,0)),"^",3)'["I"
QUIT
+3 KILL DIE
SET DA(1)=PSSIEN
SET DA=PSSDOSA
SET DR=3
SET DIE="^PSDRUG("_PSSIEN_",""DOS1"","
DO ^DIE
KILL DIE
+4 QUIT
BCMA1 ;
+1 IF $PIECE($GET(^PSDRUG(PSSIEN,2)),"^",3)'["I"
IF $PIECE($GET(^(2)),"^",3)'["U"
QUIT
+2 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSDOSA,0)),"^",2)'["I"
QUIT
+3 KILL DIE
SET DA(1)=PSSIEN
SET DA=PSSDOSA
SET DR=2
SET DIE="^PSDRUG("_PSSIEN_",""DOS2"","
DO ^DIE
KILL DIE
+4 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 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
+5 ;
+6 ;
XNWS ;
+1 NEW PSSDESTP
SET PSSDESTP=1
+2 WRITE !!,"Strength from National Drug File match => "_$SELECT($EXTRACT($GET(PSSNATST),1)=".":"0",1:"")_$GET(PSSNATST)_" "_$PIECE($GET(^PS(50.607,+$GET(PSSUN),0)),"^")
+3 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:"")
DO MS^PSSDSPOP
+4 KILL PSSDESTP
+5 QUIT
MPD ; manually enter poosible dosage
+1 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")=""
if $PIECE(^PSDRUG(PSSIEN,"ND"),"^",2)]""
SET ^PSDRUG(PSSIEN,"DOS")=PSSNATST_"^"_PSSNATUN
+2 IF PSSXYZ
IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
Begin DoDot:1
+3 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want to manually enter possible dosages"
SET DIR("?")=" "
+4 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."
+5 WRITE !!!,"This drug can have Possible Dosages, but currently does not have any.",!
+6 SET PSSZ=1
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."),!
End DoDot:1
DO ^DIR
KILL DIR
IF 'Y
WRITE !
KILL PSSXYZ
if $DATA(PSSZ)
KILL PSSZ
IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
GOTO LOCX
QUIT
+7 DO XNWS
DO STR
DO DOSA
+8 QUIT
