PSSVIDRG.m

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 ---PSSVIDRG   11413     printed  Feb 19, 2025@00:00:42                                                                                                                                                                                                   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)