- 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
