PSSDOSER ;BIR/RTR-Dose edit option ;03/10/00
;;1.0;PHARMACY DATA MANAGEMENT;**34,38,50,57,47,68,82,125,129**;9/30/97;Build 67
;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
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.",!
SKIP ;
K PSSXYZ
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 !
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"";3;@1;2",DIE="^PSDRUG("_PSSIEN_",""DOS1""," D ^DIE K DIE D:'$D(Y)&('$D(DTOUT)) BCMA G:$D(Y)!($D(DTOUT)) DOSLOC
G DOSA
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 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")="N",DIR("A")="Edit 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)
;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
PSSDOSER ;BIR/RTR-Dose edit option ;03/10/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,50,57,47,68,82,125,129**;9/30/97;Build 67
+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 $GET(PSSST)
DO XNWS
IF $GET(PSSST)
IF $ORDER(^PSDRUG(PSSIEN,"DOS1",0))
DO STR
GOTO SKIP
+5 IF PSSXYZ
IF '$ORDER(^PSDRUG(PSSIEN,"DOS1",0))
Begin DoDot:1
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Create Possible Dosages for this drug"
SET DIR("?")=" "
+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."
+9 WRITE !!!,"This drug can have Possible Dosages, but currently does not have any.",!
End DoDot:1
DO ^DIR
KILL DIR
IF Y=1
SET PSSSKIPP=1
DO EN2^PSSUTIL(PSSIEN,1)
GOTO RES
SKIP ;
+1 KILL PSSXYZ
+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 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
+3 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
+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;2"
SET DIE="^PSDRUG("_PSSIEN_",""DOS1"","
DO ^DIE
KILL DIE
IF '$DATA(Y)&('$DATA(DTOUT))
DO BCMA
IF $DATA(Y)!($DATA(DTOUT))
GOTO DOSLOC
+6 GOTO DOSA
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 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")="N"
SET DIR("A")="Edit Strength"
DO ^DIR
KILL DIR
IF 'Y
WRITE !
QUIT
+5 WRITE !
KILL DIE
SET DIE="^PSDRUG("
SET DA=PSSIEN
SET DR=901
DO ^DIE
KILL DIE
WRITE !
+6 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS")),"^")=""
KILL ^PSDRUG(PSSIEN,"DOS")
KILL ^PSDRUG(PSSIEN,"DOS1")
WRITE !!,"Deleting Strength has deleted all Possible Dosages!",!
+7 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 ;I $G(PSSST) S PSSXYZ=1 Q
+5 IF 'PSSNATDF!('PSSNATUN)!($GET(PSSNATST)="")
QUIT
+6 IF '$DATA(^PS(50.606,PSSNATDF,0))!('$DATA(^PS(50.607,PSSNATUN,0)))
QUIT
+7 IF PSSNATST'?.N&(PSSNATST'?.N1".".N)
QUIT
+8 IF $DATA(^PS(50.606,"ACONI",PSSNATDF,PSSNATUN))
IF $ORDER(^PS(50.606,"ADUPI",PSSNATDF,0))
SET (PSSXYZ,PSSIZZ)=1
+9 IF $DATA(^PS(50.606,"ACONO",PSSNATDF,PSSNATUN))
IF $ORDER(^PS(50.606,"ADUPO",PSSNATDF,0))
SET (PSSXYZ,PSSOZZ)=1
+10 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
