PSSVIDRG ;BIR/PR,WRT-ADD OR EDIT IV DRUGS ;June 3, 2018@20:00
;;1.0;PHARMACY DATA MANAGEMENT;**2,10,32,38,125,146,174,189,229**;9/30/97;Build 1
;
;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.
;
ENS ;Enter here to enter/edit solutions
N FI,PSPRNM 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 ;
; PSS*1*146 Compare and confirm SOLUTION Print name change
N DA,DIC,DLAYGO,II,PSDA,PSI,PSSY,PSSDG,PSSEL1,PSSDRG
NS2 S PSI=0 I $G(DISPDRG),$O(^PS(52.7,"AC",DISPDRG,0)) S PSSY=0 F S PSSY=$O(^PS(52.7,"AC",DISPDRG,PSSY)) Q:'PSSY S PSI=PSI+1,PSSY(PSI)=PSSY
;I PSI=1 S DIC("B")=$G(PSSY(1)) S DIC=FI,DIC(0)="QEALMNTV",DLAYGO=52.7,DIC("T")="" D ^DIC I Y<0 K PSFLGA G K1
I PSI=0 S DIC=FI,DIC(0)="QEALMNTV",DLAYGO=52.7 D ^DIC I Y<0 K PSFLGA G K1
;
ENS2 ; IV Solutions Editing
N PSSQOX
S PSSQUIT=0,PSSQOX=1
I '$G(PSFLGA)&(PSI>0) F D Q:$G(Y)
. W !!," ",$$GET1^DIQ(50,DISPDRG,.01)," currently linked to IV Solutions:",!
. S (PSDA,II)=0 F S PSDA=$O(PSSY(PSDA)) Q:'PSDA S II=II+1 W !,?3,II_". ",$P(^PS(52.7,$G(PSSY(PSDA)),0),"^")_" "_$P(^PS(52.7,$G(PSSY(PSDA)),0),"^",3)
. W !!,"Select "_$S(PSI=1:1,1:"1-"_PSI)_" from list above or type 'NEW' to link to a new IV Solution: "
. R X:DTIME I '$T!("^"[X) S Y=-1 Q
. W ! I $$UP^XLFSTR(X)="NEW" D NEW(52.7) Q
. I '$D(PSSY(X)) W !!,"Select the number corresponding to the IV SOLUTION you want to edit",!,"or type 'NEW' to link ",$$GET1^DIQ(50,DISPDRG,.01)," to a new IV SOLUTION.",$C(7) Q
. I $D(PSSY(X)) S Y=$G(PSSY(X))
G K1:($G(Y)<0)
W ! K PSSEL1 S PSSASK="SOLUTIONS",DRUG=+Y,DIE=FI,(DA,ENTRY)=+Y,DR=".01" D EECK G K1:$G(PSSEL1)="^" I $G(PSSEL1)=2 S Y=0 W ! G NS2
N PSSQUIT,PSSINADT S PSSQUIT=0
S PSSINADT=$$GET1^DIQ(52.7,ENTRY,8,"I")
S PSSDRG=$P($G(^PS(52.7,ENTRY,0)),"^",2),DA=ENTRY
S DIE="^PS(52.7,",DR="D PRNMHD^PSSVIDRG;.01;.01///^S X=$$PRNM^PSSVIDRG();.02;"
S DR=DR_"1///^S X=$$GEND^PSSVIDRG($S($G(DISPDRG):DISPDRG,$G(PSSDRG):PSSDRG,1:""""));D GETD^PSSVIDRG;"
S DR=DR_"2:7;@8;8;D IVSOLINA^PSSVIDRG;10:15;17:99999"
N PSSENTRY I $G(DA) S PSSENTRY=DA D ^DIE I '$G(PSSQUIT) S PSSQOX=0 D MFS^PSSDEE K PSFLGS,PSSY
Q
ENA ;Enter here to enter/edit additives.
N FI,PSPRNM 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 ;
; PSS*1*146 Compare and confirm ADDITIVE Print name change
N DA,DIC,DIE,DLAYGO,PSI,PSSY,PSSEL1,PSSDRG
NA2 S PSI=0
I $G(DISPDRG),$O(^PS(52.6,"AC",DISPDRG,0)) D
. S PSSY=0 F S PSSY=$O(^PS(52.6,"AC",DISPDRG,PSSY)) Q:'PSSY S PSI=PSI+1,PSSY(PSI)=PSSY
;I PSI=1 S DIC("B")=$G(PSSY(1)) S DIC=FI,DIC(0)="QEALMNTV",DLAYGO=52.6,DIC("T")="" D ^DIC I Y<0 K PSFLGA G K1
I PSI=0 S DIC=FI,DIC(0)="QEALMNTV",DLAYGO=52.6 D ^DIC I Y<0 K PSFLGA G K1
;
ENA2 ; IV Additives Editing
N PSSQOX
S PSSQUIT=0,PSSQOX=1
I '$G(PSFLGA)&(PSI>0) F D Q:$G(Y)
. W !!," ",$$GET1^DIQ(50,DISPDRG,.01)," currently linked to the following IV Additives:",!
. S (PSDA,II)=0 F S PSDA=$O(PSSY(PSDA)) Q:'PSDA D
.. S PSSY15=$P(^PS(52.6,$G(PSSY(PSDA)),0),"^",15) I $E($G(PSSY15))="." S PSSY15="0"_PSSY15
.. S II=II+1 W !,?3,II_". ",$P(^PS(52.6,$G(PSSY(PSDA)),0),"^"),?32,"Additive Strength: "_$S($G(PSSY15)="":"N/A",1:$G(PSSY15))_" "_$S($G(PSSY15)="":"",1:$$GET1^DIQ(52.6,$G(PSSY(PSDA)),2))
.. W:$D(^PSDRUG(+$P(^PS(52.6,$G(PSSY(PSDA)),0),"^",2),0)) !?15,$P(^(0),"^",10)
.. F PSIV=0:0 S PSIV=$O(^PS(52.6,$G(PSSY(PSDA)),1,PSIV)) Q:'PSIV D
... W !?7,"- ",$P(^(PSIV,0),"^")," - Quick Code Strength: ",$S($P($G(^PS(52.6,$G(PSSY(PSDA)),1,PSIV,0)),"^",2)'="":$P($G(^PS(52.6,$G(PSSY(PSDA)),1,PSIV,0)),"^",2),1:"N/A")
... W " Schedule: ",$S($P($G(^PS(52.6,$G(PSSY(PSDA)),1,PSIV,0)),"^",5)'="":$P($G(^PS(52.6,$G(PSSY(PSDA)),1,PSIV,0)),"^",5),1:"N/A"),!
. W !!,"Select "_$S(PSI=1:1,1:"1-"_PSI)_" from list above or type 'NEW' to link to a new IV Additive: "
. R X:DTIME I '$T!("^"[X) S Y=-1 Q
. W ! I $$UP^XLFSTR(X)="NEW" D NEW(52.6) Q
. I '$D(PSSY(X)) W !!,"Select the number corresponding to the IV ADDITIVE you want to edit",!,"or type 'NEW' to link ",$$GET1^DIQ(50,DISPDRG,.01)," to a new IV ADDITIVE.",$C(7) Q
. I $D(PSSY(X)) S Y=$G(PSSY(X))
G K1:($G(Y)<0)
K PSSEL1 S PSSASK="ADDITIVES",DRUG=+Y,DIE=FI,(DA,ENTRY)=+Y D EECK G K1:$G(PSSEL1)="^" I $G(PSSEL1)=2 S Y=0 W ! G NA2
S PSSDRG=$P($G(^PS(52.6,ENTRY,0)),"^",2),DIE="^PS(52.6,",DA=ENTRY,DR="[PSSIV ADD]"
N PSSENTRY I '$G(PSSQUIT),$G(DA) S PSSENTRY=DA D ^DIE S ENTRY=PSSENTRY,PSSQOX=0 D MFA^PSSDEE
K PSFLGA,PSSY,PSSY15
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")) D
. 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 FILE=$S(PSSASK="ADDITIVES":$G(^PS(52.6,ENTRY,0)),1:$G(^PS(52.7,ENTRY,0))),PSSIEN=$P(FILE,"^",2) D:PSSIEN']"" PASSIN I PSSIEN'=DISPDRG D:$D(^PSDRUG(PSSIEN)) ECK,EECK1 D
. W !,"Do you really want to link this ",$S(PSSASK="ADDITIVES":"Additive",1:"Solution")," to ",$P(^PSDRUG(DISPDRG,0),"^",1)
. F S %=2 D YN^DICN Q:% W !," (A 'YES' or 'NO' response is required.)"
. I %Y="^" S PSSEL1="^" Q
. S PSSEL1=%
Q
EECK1 Q:'$D(^PSDRUG(PSSIEN,0)) W !,"This Additive or Solution is linked 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 linked 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 FILE=$S(PSSASK="ADDITIVES":$G(^PS(52.6,ENTRY,0)),1:$G(^PS(52.7,ENTRY,0))) S (X,PSSIEN)=DISPDRG ;146
Q
MASTER F PSSOR=0:0 S PSSOR=$O(^PS(50.7,PSSOR)) Q:'PSSOR D EN2^PSSHL1(PSSOR,"MUP")
Q
PRNMHD ; PSS*1*146 Hold the print name when editing
N FI K PSPRNM
S FI=DIC I FI'["^" S FI="^PS("_FI_","
S FI=FI_DA_",0)",PSPRNM=$P($G(@FI),"^")
Q
PRNM() ; PSS*1*146 compare and confirm Print name change
N PRNMDONE,%,FI,PRNAME,DUP,DUPLIC S PRNMDONE=0
S FI=DIC I FI'["^" S FI="^PS("_FI_","
S FI=FI_DA_",0)",PRNAME=$P($G(@FI),"^")
I (PSPRNM]"")&(PRNAME]"")&(PSPRNM'=PRNAME) F Q:$G(PRNMDONE) D
. W !," ARE YOU SURE YOU WANT TO CHANGE THE PRINT NAME TO "_PRNAME
. S %=2 D YN^DICN
. S:(%=1) PSPRNM=PRNAME S:% PRNMDONE=1
. I %Y="^" S PSSQUIT=1,PRNMDONE=1
. I 'PRNMDONE W !," Answer with 'Yes' or 'No'.",$C(7),! Q
. W !," PRINT NAME set to "_PSPRNM
Q PSPRNM
GEND(CUR) ;PSS*1*146
;Ask and Confirm generic drug.
;Returns Selected drug IEN (file 50)
; CUR -> Default (Current Drug)
N DIC,%,PSSEL,Y,X
S PSSEL=0,DIC=50,DIC("A")="GENERIC DRUG: ",DIC(0)="AEMQ",DIC("B")=$S($G(CUR):CUR,1:"")
F D Q:PSSEL=1
. D ^DIC W:(Y>0)&($G(CUR)']"") " ??" I $G(CUR)]""!(Y'>0),$G(DUOUT)!$G(DTOUT) S PSSEL=1,PSSQUIT=1 Q
. I +Y=+CUR D I PSSEL=1 Q
. . I PSSASK="ADDITIVES",$D(^PS(52.6,"AC",+Y,+$G(DA))) S PSSEL=1 Q
. . I PSSASK="SOLUTIONS",$D(^PS(52.7,"AC",+Y,+$G(DA))) S PSSEL=1 Q
. I Y>0 F D Q:$G(PSSEL)
. . N CURADD,CURGEND
. . S CURADD=$S($G(PSSASK)="ADDITIVES":$$GET1^DIQ(52.6,$G(DA),.01,"E"),1:$$GET1^DIQ(52.7,$G(DA),.01,"E"))
. . S CURGEND=$$GET1^DIQ($S($G(PSSASK)="ADDITIVES":52.6,1:52.7),$G(DA),1,"E")
. . W !!," You are about to change the GENERIC DRUG linked to this "_$S($G(PSSASK)="ADDITIVES":"ADDITIVE.",1:"SOLUTION.")
. . W !," "_$S($G(PSSASK)="ADDITIVES":"ADDITIVE",1:"SOLUTION")_" "_$G(CURADD)_" is "_$S($G(CURGEND)="":"not ",1:"")_"currently linked to "_$S($G(CURGEND)="":"any",1:"")
. . W !," GENERIC DRUG "_$G(CURGEND)_"."
. . W !!," Are you sure you want to link "_$S($G(PSSASK)="ADDITIVES":"ADDITIVE",1:"SOLUTION")_" "_$G(CURADD)
. . W !," to GENERIC DRUG "_$$GET1^DIQ(50,+Y,.01,"E")
. . S %=2 D YN^DICN S:% PSSEL=% I %Y="^" S PSSQUIT=1,DUOUT=1,PSSEL=1 Q
. . I 'PSSEL W !," Answer with 'Yes' or 'No'.",$C(7),! Q
Q $S($G(DUOUT)!$G(DTOUT)!(Y<0):"^",1:+Y)
;
NEW(FI) ; add new additive/solution
N DA,DIC,DIE,DR,DLAYGO
S (DLAYGO,DIC)=FI,DIC(0)="QEALMNTV",DIC("T")="" D ^DIC K DIC
Q
;
IVSOLINA ; Checking for Duplicate IV Solution Volume when INACTIVATION DATE is removed
; Global variable: PSSINADT - INACTIVATION DATE value being deleted
I '$G(PSSINADT),$$GET1^DIQ(52.7,DA,8,"I") S PSSINADT=$$GET1^DIQ(52.7,DA,8,"I")
;I +$G(PSSINADT),('X&PSSINADT)!(X&(X'=PSSINADT)) D
I 'X!(X>DT) D
. N OI
. I $$GET1^DIQ(52.7,DA,17,"I") D
. . S OI=+$$GET1^DIQ(52.7,DA,9,"I")
. . I $$CKDUPSOL^PSSDDUT2(OI,DA,+$$GET1^DIQ(52.7,DA,2),1) D
. . . S $P(^PS(52.7,DA,"I"),"^")=$G(PSSINADT)
. . . S Y="@8"
. . E S PSSINADT=X
E S PSSINADT=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSVIDRG 11413 printed Oct 16, 2024@18:35:23 Page 2
PSSVIDRG ;BIR/PR,WRT-ADD OR EDIT IV DRUGS ;June 3, 2018@20:00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**2,10,32,38,125,146,174,189,229**;9/30/97;Build 1
+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 ;
ENS ;Enter here to enter/edit solutions
+1 NEW FI,PSPRNM
SET DRUGEDIT=1
SET FI=52.7
+2 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 ; PSS*1*146 Compare and confirm SOLUTION Print name change
+2 NEW DA,DIC,DLAYGO,II,PSDA,PSI,PSSY,PSSDG,PSSEL1,PSSDRG
NS2 SET PSI=0
IF $GET(DISPDRG)
IF $ORDER(^PS(52.7,"AC",DISPDRG,0))
SET PSSY=0
FOR
SET PSSY=$ORDER(^PS(52.7,"AC",DISPDRG,PSSY))
if 'PSSY
QUIT
SET PSI=PSI+1
SET PSSY(PSI)=PSSY
+1 ;I PSI=1 S DIC("B")=$G(PSSY(1)) S DIC=FI,DIC(0)="QEALMNTV",DLAYGO=52.7,DIC("T")="" D ^DIC I Y<0 K PSFLGA G K1
+2 IF PSI=0
SET DIC=FI
SET DIC(0)="QEALMNTV"
SET DLAYGO=52.7
DO ^DIC
IF Y<0
KILL PSFLGA
GOTO K1
+3 ;
ENS2 ; IV Solutions Editing
+1 NEW PSSQOX
+2 SET PSSQUIT=0
SET PSSQOX=1
+3 IF '$GET(PSFLGA)&(PSI>0)
FOR
Begin DoDot:1
+4 WRITE !!," ",$$GET1^DIQ(50,DISPDRG,.01)," currently linked to IV Solutions:",!
+5 SET (PSDA,II)=0
FOR
SET PSDA=$ORDER(PSSY(PSDA))
if 'PSDA
QUIT
SET II=II+1
WRITE !,?3,II_". ",$PIECE(^PS(52.7,$GET(PSSY(PSDA)),0),"^")_" "_$PIECE(^PS(52.7,$GET(PSSY(PSDA)),0),"^",3)
+6 WRITE !!,"Select "_$SELECT(PSI=1:1,1:"1-"_PSI)_" from list above or type 'NEW' to link to a new IV Solution: "
+7 READ X:DTIME
IF '$TEST!("^"[X)
SET Y=-1
QUIT
+8 WRITE !
IF $$UP^XLFSTR(X)="NEW"
DO NEW(52.7)
QUIT
+9 IF '$DATA(PSSY(X))
WRITE !!,"Select the number corresponding to the IV SOLUTION you want to edit",!,"or type 'NEW' to link ",$$GET1^DIQ(50,DISPDRG,.01)," to a new IV SOLUTION.",$CHAR(7)
QUIT
+10 IF $DATA(PSSY(X))
SET Y=$GET(PSSY(X))
End DoDot:1
if $GET(Y)
QUIT
+11 if ($GET(Y)<0)
GOTO K1
+12 WRITE !
KILL PSSEL1
SET PSSASK="SOLUTIONS"
SET DRUG=+Y
SET DIE=FI
SET (DA,ENTRY)=+Y
SET DR=".01"
DO EECK
if $GET(PSSEL1)="^"
GOTO K1
IF $GET(PSSEL1)=2
SET Y=0
WRITE !
GOTO NS2
+13 NEW PSSQUIT,PSSINADT
SET PSSQUIT=0
+14 SET PSSINADT=$$GET1^DIQ(52.7,ENTRY,8,"I")
+15 SET PSSDRG=$PIECE($GET(^PS(52.7,ENTRY,0)),"^",2)
SET DA=ENTRY
+16 SET DIE="^PS(52.7,"
SET DR="D PRNMHD^PSSVIDRG;.01;.01///^S X=$$PRNM^PSSVIDRG();.02;"
+17 SET DR=DR_"1///^S X=$$GEND^PSSVIDRG($S($G(DISPDRG):DISPDRG,$G(PSSDRG):PSSDRG,1:""""));D GETD^PSSVIDRG;"
+18 SET DR=DR_"2:7;@8;8;D IVSOLINA^PSSVIDRG;10:15;17:99999"
+19 NEW PSSENTRY
IF $GET(DA)
SET PSSENTRY=DA
DO ^DIE
IF '$GET(PSSQUIT)
SET PSSQOX=0
DO MFS^PSSDEE
KILL PSFLGS,PSSY
+20 QUIT
ENA ;Enter here to enter/edit additives.
+1 NEW FI,PSPRNM
SET DRUGEDIT=1
SET FI=52.6
+2 LOCK +^PS(FI):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE $CHAR(7),!!,"Someone else is entering drugs ... try later !",!!
GOTO K
+3 ;
ENA1 ;
+1 ; PSS*1*146 Compare and confirm ADDITIVE Print name change
+2 NEW DA,DIC,DIE,DLAYGO,PSI,PSSY,PSSEL1,PSSDRG
NA2 SET PSI=0
+1 IF $GET(DISPDRG)
IF $ORDER(^PS(52.6,"AC",DISPDRG,0))
Begin DoDot:1
+2 SET PSSY=0
FOR
SET PSSY=$ORDER(^PS(52.6,"AC",DISPDRG,PSSY))
if 'PSSY
QUIT
SET PSI=PSI+1
SET PSSY(PSI)=PSSY
End DoDot:1
+3 ;I PSI=1 S DIC("B")=$G(PSSY(1)) S DIC=FI,DIC(0)="QEALMNTV",DLAYGO=52.6,DIC("T")="" D ^DIC I Y<0 K PSFLGA G K1
+4 IF PSI=0
SET DIC=FI
SET DIC(0)="QEALMNTV"
SET DLAYGO=52.6
DO ^DIC
IF Y<0
KILL PSFLGA
GOTO K1
+5 ;
ENA2 ; IV Additives Editing
+1 NEW PSSQOX
+2 SET PSSQUIT=0
SET PSSQOX=1
+3 IF '$GET(PSFLGA)&(PSI>0)
FOR
Begin DoDot:1
+4 WRITE !!," ",$$GET1^DIQ(50,DISPDRG,.01)," currently linked to the following IV Additives:",!
+5 SET (PSDA,II)=0
FOR
SET PSDA=$ORDER(PSSY(PSDA))
if 'PSDA
QUIT
Begin DoDot:2
+6 SET PSSY15=$PIECE(^PS(52.6,$GET(PSSY(PSDA)),0),"^",15)
IF $EXTRACT($GET(PSSY15))="."
SET PSSY15="0"_PSSY15
+7 SET II=II+1
WRITE !,?3,II_". ",$PIECE(^PS(52.6,$GET(PSSY(PSDA)),0),"^"),?32,"Additive Strength: "_$SELECT($GET(PSSY15)="":"N/A",1:$GET(PSSY15))_" "_$SELECT($GET(PSSY15)="":"",1:$$GET1^DIQ(52.6,$GET(PSSY(PSDA)),2))
+8 if $DATA(^PSDRUG(+$PIECE(^PS(52.6,$GET(PSSY(PSDA)),0),"^",2),0))
WRITE !?15,$PIECE(^(0),"^",10)
+9 FOR PSIV=0:0
SET PSIV=$ORDER(^PS(52.6,$GET(PSSY(PSDA)),1,PSIV))
if 'PSIV
QUIT
Begin DoDot:3
+10 WRITE !?7,"- ",$PIECE(^(PSIV,0),"^")," - Quick Code Strength: ",$SELECT($PIECE($GET(^PS(52.6,$GET(PSSY(PSDA)),1,PSIV,0)),"^",2)'="":$PIECE($GET(^PS(52.6,$GET(PSSY(PSDA)),1,PSIV,0)),"^",2),1:"N/A")
+11 WRITE " Schedule: ",$SELECT($PIECE($GET(^PS(52.6,$GET(PSSY(PSDA)),1,PSIV,0)),"^",5)'="":$PIECE($GET(^PS(52.6,$GET(PSSY(PSDA)),1,PSIV,0)),"^",5),1:"N/A"),!
End DoDot:3
End DoDot:2
+12 WRITE !!,"Select "_$SELECT(PSI=1:1,1:"1-"_PSI)_" from list above or type 'NEW' to link to a new IV Additive: "
+13 READ X:DTIME
IF '$TEST!("^"[X)
SET Y=-1
QUIT
+14 WRITE !
IF $$UP^XLFSTR(X)="NEW"
DO NEW(52.6)
QUIT
+15 IF '$DATA(PSSY(X))
WRITE !!,"Select the number corresponding to the IV ADDITIVE you want to edit",!,"or type 'NEW' to link ",$$GET1^DIQ(50,DISPDRG,.01)," to a new IV ADDITIVE.",$CHAR(7)
QUIT
+16 IF $DATA(PSSY(X))
SET Y=$GET(PSSY(X))
End DoDot:1
if $GET(Y)
QUIT
+17 if ($GET(Y)<0)
GOTO K1
+18 KILL PSSEL1
SET PSSASK="ADDITIVES"
SET DRUG=+Y
SET DIE=FI
SET (DA,ENTRY)=+Y
DO EECK
if $GET(PSSEL1)="^"
GOTO K1
IF $GET(PSSEL1)=2
SET Y=0
WRITE !
GOTO NA2
+19 SET PSSDRG=$PIECE($GET(^PS(52.6,ENTRY,0)),"^",2)
SET DIE="^PS(52.6,"
SET DA=ENTRY
SET DR="[PSSIV ADD]"
+20 NEW PSSENTRY
IF '$GET(PSSQUIT)
IF $GET(DA)
SET PSSENTRY=DA
DO ^DIE
SET ENTRY=PSSENTRY
SET PSSQOX=0
DO MFA^PSSDEE
+21 KILL PSFLGA,PSSY,PSSY15
+22 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
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"))
Begin DoDot:1
+2 WRITE $CHAR(7),$CHAR(7),!!,"This drug is inactive and will not be selectable during IV order entry.",!
+3 SET ^PS(FI,DRUG,"I")=^PSDRUG(X,"I")
End DoDot:1
+4 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)
SET FILE=$SELECT(PSSASK="ADDITIVES":$GET(^PS(52.6,ENTRY,0)),1:$GET(^PS(52.7,ENTRY,0)))
SET PSSIEN=$PIECE(FILE,"^",2)
if PSSIEN']""
DO PASSIN
IF PSSIEN'=DISPDRG
if $DATA(^PSDRUG(PSSIEN))
DO ECK
DO EECK1
Begin DoDot:1
+1 WRITE !,"Do you really want to link this ",$SELECT(PSSASK="ADDITIVES":"Additive",1:"Solution")," to ",$PIECE(^PSDRUG(DISPDRG,0),"^",1)
+2 FOR
SET %=2
DO YN^DICN
if %
QUIT
WRITE !," (A 'YES' or 'NO' response is required.)"
+3 IF %Y="^"
SET PSSEL1="^"
QUIT
+4 SET PSSEL1=%
End DoDot:1
+5 QUIT
EECK1 if '$DATA(^PSDRUG(PSSIEN,0))
QUIT
WRITE !,"This Additive or Solution is linked 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 linked 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 ;146
SET FILE=$SELECT(PSSASK="ADDITIVES":$GET(^PS(52.6,ENTRY,0)),1:$GET(^PS(52.7,ENTRY,0)))
SET (X,PSSIEN)=DISPDRG
+1 QUIT
MASTER FOR PSSOR=0:0
SET PSSOR=$ORDER(^PS(50.7,PSSOR))
if 'PSSOR
QUIT
DO EN2^PSSHL1(PSSOR,"MUP")
+1 QUIT
PRNMHD ; PSS*1*146 Hold the print name when editing
+1 NEW FI
KILL PSPRNM
+2 SET FI=DIC
IF FI'["^"
SET FI="^PS("_FI_","
+3 SET FI=FI_DA_",0)"
SET PSPRNM=$PIECE($GET(@FI),"^")
+4 QUIT
PRNM() ; PSS*1*146 compare and confirm Print name change
+1 NEW PRNMDONE,%,FI,PRNAME,DUP,DUPLIC
SET PRNMDONE=0
+2 SET FI=DIC
IF FI'["^"
SET FI="^PS("_FI_","
+3 SET FI=FI_DA_",0)"
SET PRNAME=$PIECE($GET(@FI),"^")
+4 IF (PSPRNM]"")&(PRNAME]"")&(PSPRNM'=PRNAME)
FOR
if $GET(PRNMDONE)
QUIT
Begin DoDot:1
+5 WRITE !," ARE YOU SURE YOU WANT TO CHANGE THE PRINT NAME TO "_PRNAME
+6 SET %=2
DO YN^DICN
+7 if (%=1)
SET PSPRNM=PRNAME
if %
SET PRNMDONE=1
+8 IF %Y="^"
SET PSSQUIT=1
SET PRNMDONE=1
+9 IF 'PRNMDONE
WRITE !," Answer with 'Yes' or 'No'.",$CHAR(7),!
QUIT
+10 WRITE !," PRINT NAME set to "_PSPRNM
End DoDot:1
+11 QUIT PSPRNM
GEND(CUR) ;PSS*1*146
+1 ;Ask and Confirm generic drug.
+2 ;Returns Selected drug IEN (file 50)
+3 ; CUR -> Default (Current Drug)
+4 NEW DIC,%,PSSEL,Y,X
+5 SET PSSEL=0
SET DIC=50
SET DIC("A")="GENERIC DRUG: "
SET DIC(0)="AEMQ"
SET DIC("B")=$SELECT($GET(CUR):CUR,1:"")
+6 FOR
Begin DoDot:1
+7 DO ^DIC
if (Y>0)&($GET(CUR)']"")
WRITE " ??"
IF $GET(CUR)]""!(Y'>0)
IF $GET(DUOUT)!$GET(DTOUT)
SET PSSEL=1
SET PSSQUIT=1
QUIT
+8 IF +Y=+CUR
Begin DoDot:2
+9 IF PSSASK="ADDITIVES"
IF $DATA(^PS(52.6,"AC",+Y,+$GET(DA)))
SET PSSEL=1
QUIT
+10 IF PSSASK="SOLUTIONS"
IF $DATA(^PS(52.7,"AC",+Y,+$GET(DA)))
SET PSSEL=1
QUIT
End DoDot:2
IF PSSEL=1
QUIT
+11 IF Y>0
FOR
Begin DoDot:2
+12 NEW CURADD,CURGEND
+13 SET CURADD=$SELECT($GET(PSSASK)="ADDITIVES":$$GET1^DIQ(52.6,$GET(DA),.01,"E"),1:$$GET1^DIQ(52.7,$GET(DA),.01,"E"))
+14 SET CURGEND=$$GET1^DIQ($SELECT($GET(PSSASK)="ADDITIVES":52.6,1:52.7),$GET(DA),1,"E")
+15 WRITE !!," You are about to change the GENERIC DRUG linked to this "_$SELECT($GET(PSSASK)="ADDITIVES":"ADDITIVE.",1:"SOLUTION.")
+16 WRITE !," "_$SELECT($GET(PSSASK)="ADDITIVES":"ADDITIVE",1:"SOLUTION")_" "_$GET(CURADD)_" is "_$SELECT($GET(CURGEND)="":"not ",1:"")_"currently linked to "_$SELECT($GET(CURGEND)="":"any",1:"")
+17 WRITE !," GENERIC DRUG "_$GET(CURGEND)_"."
+18 WRITE !!," Are you sure you want to link "_$SELECT($GET(PSSASK)="ADDITIVES":"ADDITIVE",1:"SOLUTION")_" "_$GET(CURADD)
+19 WRITE !," to GENERIC DRUG "_$$GET1^DIQ(50,+Y,.01,"E")
+20 SET %=2
DO YN^DICN
if %
SET PSSEL=%
IF %Y="^"
SET PSSQUIT=1
SET DUOUT=1
SET PSSEL=1
QUIT
+21 IF 'PSSEL
WRITE !," Answer with 'Yes' or 'No'.",$CHAR(7),!
QUIT
End DoDot:2
if $GET(PSSEL)
QUIT
End DoDot:1
if PSSEL=1
QUIT
+22 QUIT $SELECT($GET(DUOUT)!$GET(DTOUT)!(Y<0):"^",1:+Y)
+23 ;
NEW(FI) ; add new additive/solution
+1 NEW DA,DIC,DIE,DR,DLAYGO
+2 SET (DLAYGO,DIC)=FI
SET DIC(0)="QEALMNTV"
SET DIC("T")=""
DO ^DIC
KILL DIC
+3 QUIT
+4 ;
IVSOLINA ; Checking for Duplicate IV Solution Volume when INACTIVATION DATE is removed
+1 ; Global variable: PSSINADT - INACTIVATION DATE value being deleted
+2 IF '$GET(PSSINADT)
IF $$GET1^DIQ(52.7,DA,8,"I")
SET PSSINADT=$$GET1^DIQ(52.7,DA,8,"I")
+3 ;I +$G(PSSINADT),('X&PSSINADT)!(X&(X'=PSSINADT)) D
+4 IF 'X!(X>DT)
Begin DoDot:1
+5 NEW OI
+6 IF $$GET1^DIQ(52.7,DA,17,"I")
Begin DoDot:2
+7 SET OI=+$$GET1^DIQ(52.7,DA,9,"I")
+8 IF $$CKDUPSOL^PSSDDUT2(OI,DA,+$$GET1^DIQ(52.7,DA,2),1)
Begin DoDot:3
+9 SET $PIECE(^PS(52.7,DA,"I"),"^")=$GET(PSSINADT)
+10 SET Y="@8"
End DoDot:3
+11 IF '$TEST
SET PSSINADT=X
End DoDot:2
End DoDot:1
+12 IF '$TEST
SET PSSINADT=X
+13 QUIT
