PSSVIDRG ;BIR/PR,WRT-ADD OR EDIT IV DRUGS ;29-May-2012 15:18;PLS
;;1.0;PHARMACY DATA MANAGEMENT;**2,10,32,38,125,1015**;9/30/97;Build 62
;
;Reference to ENIVKV^PSGSETU is supported by DBIA # 2153.
;Reference to ^PSIV is supported by DBIA # 2155.
;Reference to ^PSIVHLP1 is supported by DBIA # 2156.
;Reference to ^PSIVXU is supported by DBIA # 2157.
;
; Modified - IHS/MSC/PB - 4/25/12 - Line ENS1+1 DR string modified to add Stability Offset Value to the edit
ENS ;Enter here to enter/edit solutions
S DRUGEDIT=1,FI=52.7 L +^PS(FI):$S($G(DILOCKTM)>0:DILOCKTM,1:3) E W $C(7),!!,"Someone else is entering drugs ... try later !",!! G K
ENS1 ;
N DA,DIC,DLAYGO S DIC=FI,DIC(0)="AEQML",DLAYGO=52.7 D ^DIC I Y<0 G K1
;IHS/MSC/PB - 04/04/2012 - next line modified to add Stability Offset Value to the DR string for the second DIE call
;S PSSASK="SOLUTIONS",DRUG=+Y,DIE=DIC,(DA,ENTRY)=+Y,DR=".01:.02" D ^DIE,EECK S DIE="^PS(52.7,",DA=ENTRY,DR="1;D GETD^PSSVIDRG;2:8;10:15;17:99999" D ^DIE,MFS^PSSDEE
S PSSASK="SOLUTIONS",DRUG=+Y,DIE=DIC,(DA,ENTRY)=+Y,DR=".01:.02" D ^DIE,EECK S DIE="^PS(52.7,",DA=ENTRY,DR="1;D GETD^PSSVIDRG;2:8;10:15;17:99999;9999999.01" D ^DIE,MFS^PSSDEE
Q
;
ENA ;Enter here to enter/edit additives.
S DRUGEDIT=1,FI=52.6 L +^PS(FI):$S($G(DILOCKTM)>0:DILOCKTM,1:3) E W $C(7),!!,"Someone else is entering drugs ... try later !",!! G K
ENA1 ;
N DA,DIC,DIE,DLAYGO S DIC=FI,DIC(0)="AEQL",DLAYGO=52.6 D ^DIC I Y<0 G K1
S PSSASK="ADDITIVES",DRUG=+Y,DIE=DIC,(DA,ENTRY)=+Y,DR=".01" D EECK S DIE="^PS(52.6,",DA=ENTRY,DR="[PSSIV ADD]" D ^DIE,MFA^PSSDEE
Q
ENC ;Enter here to enter/edit IV Categories
;S X="PSIVXU" X ^%ZOSF("TEST") I D ^PSIVXU Q:$D(XQUIT) K DA,DIC,DIE,DR,DLAYGO S DIC="^PS(50.2,",DIC(0)="AEQL",DLAYGO=50.2 D ^DIC G:Y<0 K S DIE=DIC,DR=".01;1",DA=+Y D ^DIE G K
Q
;
K1 ;
L -^PS(FI)
K S X="PSGSETU" X ^%ZOSF("TEST") I D ENIVKV^PSGSETU
KDRG K B,DA,DG,DIC,DIE,DIJ,DIX,DIY,DIYS,DLAYGO,DO,DRUG,DRUGEDIT,FI,I,J,P,PSIV,PSIVAT,PSSIVDRG,PSIVSC,XT,Z
Q
;
GETD ;See if generic drug is inactive in file 50.
I $D(^PSDRUG(X,"I")),^("I"),(DT+1>+^("I")) W $C(7),$C(7),!!,"This drug is inactive and will not be selectable during IV order entry.",! S ^PS(FI,DRUG,"I")=^PSDRUG(X,"I")
Q
ENTDRG ;This module is no longer utilized by the Inpatient Medications application.
;Will print word-processing field in IV add. file (52.6) and
;IV sol. file (52.7).
;
Q
;S X="PSIV" X ^%ZOSF("TEST") I D ^PSIV Q:$D(XQUIT)
S X="PSIV" X ^%ZOSF("TEST") I D ^PSIVHLP1 Q:$D(XQUIT)
N P W !!,"Are you inquiring on" S X="... an IV ADDITIVE or IV SOLUTION (A/S): ^ADDITIVE^^ADDITIVE,SOLUTION" D ENQ^PSIV S X=$E(X) Q:"^"[X I X["?" S HELP="DRGINQ" D ^PSIVHLP1 G ENTDRG
S FI=$S(X["A":52.6,1:52.7) N D0,D1,DA,DI,DIE,DP,DR,DQ
DRG F Y=0:0 W ! X ^DD(55.11,.01,12.1) K DA,DIC S DIC="^PS("_FI_",",DIC(0)="QEAM" D ^DIC G:Y<0 KDRG S PSSIVDRG=+Y D WPH,WP
G KDRG
WPH ;
W:$Y @IOF W ! F Y=1:1:79 W "-"
W !,"Drug information on: ",$P(^PS(FI,PSSIVDRG,0),"^")
W !?7,"Last updated: " W:'$D(^PS(FI,PSSIVDRG,4,0)) "N/A" I $D(^(0)) S Y=$P(^(0),"^",5) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2)
W ! Q
WP W ! I '$D(^PS(FI,PSSIVDRG,4,0)) W !,"*** No information on file. ***"
F Z=0:0 S Z=$O(^PS(FI,PSSIVDRG,4,Z)) Q:'Z W !,^(Z,0) I $Y+5>IOSL W $C(7),!!,"Press return key: " R I:DTIME Q:'$T!(I["^") D WPH
W ! F Y=1:1:79 W "-"
Q
ENT ;
;Will print out information on IV DRUGS
Q
;S X="PSIV" X ^%ZOSF("TEST") I D ^PSIV Q:$D(XQUIT)
S X="PSIV" X ^%ZOSF("TEST") I D ^PSIVHLP1 Q:$D(XQUIT)
;
BEG W !!,"Are you printing drug information from ..." S X="the IV ADDITIVE file or IV SOLUTION file ? ^ADDITIVE^^ADDITIVE,SOLUTION" D ENQ^PSIV G:"^"[X K I X["?" S HELP="DRGINQ" D ^PSIVHLP1 G BEG
S L=0,DIC="^PS("_$S(X["A":52.6,1:52.7)_"," D EN1^DIP D ^%ZISC G K
ELECTRO ;Edit Electrolyte file
S X="PSIVXU" X ^%ZOSF("TEST") I D ^PSIVXU Q:$D(XQUIT) K DA,DIC S DIC="^PS(50.4,",DIC(0)="AEQLM",DLAYGO=50.4 D ^DIC G:Y<0 K
S DIE=DIC,DR="[PSSJIDE]",DA=+Y D ^DIE G ELECTRO
Q
EECK I $D(PSSZ) S:PSSASK="ADDITIVES" FILE=^PS(52.6,ENTRY,0) S:PSSASK="SOLUTIONS" FILE=^PS(52.7,ENTRY,0) S PSSIEN=$P(FILE,"^",2) D:PSSIEN']"" PASSIN I PSSIEN'=DISPDRG D ECK,EECK1
Q
EECK1 W !,"This Additive or Solution is tied to ",$P(^PSDRUG(PSSIEN,0),"^",1),".",!,"You are editing dispense drug ",$P(^PSDRUG(DISPDRG,0),"^",1),".",!
Q
ECK W !,"You are editing a Additive or Solution which is tied to a different",!,"dispense drug from the one you are currently editing."
Q
SOI I $D(^PS(59.7,1,80)),$P(^PS(59.7,1,80),"^",2)>1 W !!,"You are NOW in the ORDERABLE ITEM matching for Solutions." S Y=ENTRY_"^"_$P(^PS(52.7,ENTRY,0),"^",1),PSMASTER=1 D MAS^PSSSOLIT K PSMASTER
Q
ADDOI I $D(^PS(59.7,1,80)),$P(^PS(59.7,1,80),"^",2)>1 W !!,"You are NOW in the ORDERABLE ITEM matching for Additives." S Y=ENTRY_"^"_$P(^PS(52.6,ENTRY,0),"^",1),PSMASTER=1 D MAS^PSSADDIT K PSMASTER
Q
PASSIN S:PSSASK="ADDITIVES" ROOT="^PS(52.6," S:PSSASK="SOLUTIONS" ROOT="^PS(52.7," S DIE=ROOT,DA=ENTRY,DR="1////"_DISPDRG D ^DIE D RFILE S X=DISPDRG
Q
RFILE S:PSSASK="ADDITIVES" FILE=^PS(52.6,ENTRY,0) S:PSSASK="SOLUTIONS" FILE=^PS(52.7,ENTRY,0) S PSSIEN=$P(FILE,"^",2)
Q
MASTER F PSSOR=0:0 S PSSOR=$O(^PS(50.7,PSSOR)) Q:'PSSOR D EN2^PSSHL1(PSSOR,"MUP")
Q
PSSVIDRG ;BIR/PR,WRT-ADD OR EDIT IV DRUGS ;29-May-2012 15:18;PLS
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**2,10,32,38,125,1015**;9/30/97;Build 62
+2 ;
+3 ;Reference to ENIVKV^PSGSETU is supported by DBIA # 2153.
+4 ;Reference to ^PSIV is supported by DBIA # 2155.
+5 ;Reference to ^PSIVHLP1 is supported by DBIA # 2156.
+6 ;Reference to ^PSIVXU is supported by DBIA # 2157.
+7 ;
+8 ; Modified - IHS/MSC/PB - 4/25/12 - Line ENS1+1 DR string modified to add Stability Offset Value to the edit
ENS ;Enter here to enter/edit solutions
+1 SET DRUGEDIT=1
SET FI=52.7
LOCK +^PS(FI):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE $CHAR(7),!!,"Someone else is entering drugs ... try later !",!!
GOTO K
ENS1 ;
+1 NEW DA,DIC,DLAYGO
SET DIC=FI
SET DIC(0)="AEQML"
SET DLAYGO=52.7
DO ^DIC
IF Y<0
GOTO K1
+2 ;IHS/MSC/PB - 04/04/2012 - next line modified to add Stability Offset Value to the DR string for the second DIE call
+3 ;S PSSASK="SOLUTIONS",DRUG=+Y,DIE=DIC,(DA,ENTRY)=+Y,DR=".01:.02" D ^DIE,EECK S DIE="^PS(52.7,",DA=ENTRY,DR="1;D GETD^PSSVIDRG;2:8;10:15;17:99999" D ^DIE,MFS^PSSDEE
+4 SET PSSASK="SOLUTIONS"
SET DRUG=+Y
SET DIE=DIC
SET (DA,ENTRY)=+Y
SET DR=".01:.02"
DO ^DIE
DO EECK
SET DIE="^PS(52.7,"
SET DA=ENTRY
SET DR="1;D GETD^PSSVIDRG;2:8;10:15;17:99999;9999999.01"
DO ^DIE
DO MFS^PSSDEE
+5 QUIT
+6 ;
ENA ;Enter here to enter/edit additives.
+1 SET DRUGEDIT=1
SET FI=52.6
LOCK +^PS(FI):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE $CHAR(7),!!,"Someone else is entering drugs ... try later !",!!
GOTO K
ENA1 ;
+1 NEW DA,DIC,DIE,DLAYGO
SET DIC=FI
SET DIC(0)="AEQL"
SET DLAYGO=52.6
DO ^DIC
IF Y<0
GOTO K1
+2 SET PSSASK="ADDITIVES"
SET DRUG=+Y
SET DIE=DIC
SET (DA,ENTRY)=+Y
SET DR=".01"
DO EECK
SET DIE="^PS(52.6,"
SET DA=ENTRY
SET DR="[PSSIV ADD]"
DO ^DIE
DO MFA^PSSDEE
+3 QUIT
ENC ;Enter here to enter/edit IV Categories
+1 ;S X="PSIVXU" X ^%ZOSF("TEST") I D ^PSIVXU Q:$D(XQUIT) K DA,DIC,DIE,DR,DLAYGO S DIC="^PS(50.2,",DIC(0)="AEQL",DLAYGO=50.2 D ^DIC G:Y<0 K S DIE=DIC,DR=".01;1",DA=+Y D ^DIE G K
+2 QUIT
+3 ;
K1 ;
+1 LOCK -^PS(FI)
K SET X="PSGSETU"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ENIVKV^PSGSETU
KDRG KILL B,DA,DG,DIC,DIE,DIJ,DIX,DIY,DIYS,DLAYGO,DO,DRUG,DRUGEDIT,FI,I,J,P,PSIV,PSIVAT,PSSIVDRG,PSIVSC,XT,Z
+1 QUIT
+2 ;
GETD ;See if generic drug is inactive in file 50.
+1 IF $DATA(^PSDRUG(X,"I"))
IF ^("I")
IF (DT+1>+^("I"))
WRITE $CHAR(7),$CHAR(7),!!,"This drug is inactive and will not be selectable during IV order entry.",!
SET ^PS(FI,DRUG,"I")=^PSDRUG(X,"I")
+2 QUIT
ENTDRG ;This module is no longer utilized by the Inpatient Medications application.
+1 ;Will print word-processing field in IV add. file (52.6) and
+2 ;IV sol. file (52.7).
+3 ;
+4 QUIT
+5 ;S X="PSIV" X ^%ZOSF("TEST") I D ^PSIV Q:$D(XQUIT)
+6 SET X="PSIV"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^PSIVHLP1
IF $DATA(XQUIT)
QUIT
+7 NEW P
WRITE !!,"Are you inquiring on"
SET X="... an IV ADDITIVE or IV SOLUTION (A/S): ^ADDITIVE^^ADDITIVE,SOLUTION"
DO ENQ^PSIV
SET X=$EXTRACT(X)
IF "^"[X
QUIT
IF X["?"
SET HELP="DRGINQ"
DO ^PSIVHLP1
GOTO ENTDRG
+8 SET FI=$SELECT(X["A":52.6,1:52.7)
NEW D0,D1,DA,DI,DIE,DP,DR,DQ
DRG FOR Y=0:0
WRITE !
XECUTE ^DD(55.11,.01,12.1)
KILL DA,DIC
SET DIC="^PS("_FI_","
SET DIC(0)="QEAM"
DO ^DIC
IF Y<0
GOTO KDRG
SET PSSIVDRG=+Y
DO WPH
DO WP
+1 GOTO KDRG
WPH ;
+1 IF $Y
WRITE @IOF
WRITE !
FOR Y=1:1:79
WRITE "-"
+2 WRITE !,"Drug information on: ",$PIECE(^PS(FI,PSSIVDRG,0),"^")
+3 WRITE !?7,"Last updated: "
IF '$DATA(^PS(FI,PSSIVDRG,4,0))
WRITE "N/A"
IF $DATA(^(0))
SET Y=$PIECE(^(0),"^",5)
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
+4 WRITE !
QUIT
WP WRITE !
IF '$DATA(^PS(FI,PSSIVDRG,4,0))
WRITE !,"*** No information on file. ***"
+1 FOR Z=0:0
SET Z=$ORDER(^PS(FI,PSSIVDRG,4,Z))
IF 'Z
QUIT
WRITE !,^(Z,0)
IF $Y+5>IOSL
WRITE $CHAR(7),!!,"Press return key: "
READ I:DTIME
IF '$TEST!(I["^")
QUIT
DO WPH
+2 WRITE !
FOR Y=1:1:79
WRITE "-"
+3 QUIT
ENT ;
+1 ;Will print out information on IV DRUGS
+2 QUIT
+3 ;S X="PSIV" X ^%ZOSF("TEST") I D ^PSIV Q:$D(XQUIT)
+4 SET X="PSIV"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^PSIVHLP1
IF $DATA(XQUIT)
QUIT
+5 ;
BEG WRITE !!,"Are you printing drug information from ..."
SET X="the IV ADDITIVE file or IV SOLUTION file ? ^ADDITIVE^^ADDITIVE,SOLUTION"
DO ENQ^PSIV
IF "^"[X
GOTO K
IF X["?"
SET HELP="DRGINQ"
DO ^PSIVHLP1
GOTO BEG
+1 SET L=0
SET DIC="^PS("_$SELECT(X["A":52.6,1:52.7)_","
DO EN1^DIP
DO ^%ZISC
GOTO K
ELECTRO ;Edit Electrolyte file
+1 SET X="PSIVXU"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^PSIVXU
IF $DATA(XQUIT)
QUIT
KILL DA,DIC
SET DIC="^PS(50.4,"
SET DIC(0)="AEQLM"
SET DLAYGO=50.4
DO ^DIC
IF Y<0
GOTO K
+2 SET DIE=DIC
SET DR="[PSSJIDE]"
SET DA=+Y
DO ^DIE
GOTO ELECTRO
+3 QUIT
EECK IF $DATA(PSSZ)
IF PSSASK="ADDITIVES"
SET FILE=^PS(52.6,ENTRY,0)
IF PSSASK="SOLUTIONS"
SET FILE=^PS(52.7,ENTRY,0)
SET PSSIEN=$PIECE(FILE,"^",2)
IF PSSIEN']""
DO PASSIN
IF PSSIEN'=DISPDRG
DO ECK
DO EECK1
+1 QUIT
EECK1 WRITE !,"This Additive or Solution is tied to ",$PIECE(^PSDRUG(PSSIEN,0),"^",1),".",!,"You are editing dispense drug ",$PIECE(^PSDRUG(DISPDRG,0),"^",1),".",!
+1 QUIT
ECK WRITE !,"You are editing a Additive or Solution which is tied to a different",!,"dispense drug from the one you are currently editing."
+1 QUIT
SOI IF $DATA(^PS(59.7,1,80))
IF $PIECE(^PS(59.7,1,80),"^",2)>1
WRITE !!,"You are NOW in the ORDERABLE ITEM matching for Solutions."
SET Y=ENTRY_"^"_$PIECE(^PS(52.7,ENTRY,0),"^",1)
SET PSMASTER=1
DO MAS^PSSSOLIT
KILL PSMASTER
+1 QUIT
ADDOI IF $DATA(^PS(59.7,1,80))
IF $PIECE(^PS(59.7,1,80),"^",2)>1
WRITE !!,"You are NOW in the ORDERABLE ITEM matching for Additives."
SET Y=ENTRY_"^"_$PIECE(^PS(52.6,ENTRY,0),"^",1)
SET PSMASTER=1
DO MAS^PSSADDIT
KILL PSMASTER
+1 QUIT
PASSIN IF PSSASK="ADDITIVES"
SET ROOT="^PS(52.6,"
IF PSSASK="SOLUTIONS"
SET ROOT="^PS(52.7,"
SET DIE=ROOT
SET DA=ENTRY
SET DR="1////"_DISPDRG
DO ^DIE
DO RFILE
SET X=DISPDRG
+1 QUIT
RFILE IF PSSASK="ADDITIVES"
SET FILE=^PS(52.6,ENTRY,0)
IF PSSASK="SOLUTIONS"
SET FILE=^PS(52.7,ENTRY,0)
SET PSSIEN=$PIECE(FILE,"^",2)
+1 QUIT
MASTER FOR PSSOR=0:0
SET PSSOR=$ORDER(^PS(50.7,PSSOR))
IF 'PSSOR
QUIT
DO EN2^PSSHL1(PSSOR,"MUP")
+1 QUIT
