- 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 Feb 18, 2025@23:56:57 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
