Routine: PSSPRUTL

PSSPRUTL ;BIR/RTR-Edit IV Solution ;04/19/08

 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67

EDIT ;Edit IV Solution

 N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,PSSEDSDA,PSSEDSXX,PSSEDSZZ,PSSEDSDR,PSSEDSGG,PSSEDSAR,DRUGEDIT

 ;Newing D in next line because FileMan is leaving it defined to a zero node upon option exit

 N %,%DT,D0,I,J,MSG,PSJCLEAR,PSPOINT,PSSIVID,SYNIEN,XX,PSSCROSS,D

 I '$D(^XUSEC("PSJI MGR",DUZ)) W !!!,"Sorry, you need the 'PSJI MGR' key to access this option.",! D MESS Q

 L +^PS(52.7):$S($G(DILOCKTM)>0:DILOCKTM,1:3)

 I '$T W !!!,"Sorry, someone else is editing entries in the IV SOLUTIONS (#52.7) File.",! D MESS Q

EDITM ;

 K X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,MSG,PSJCLEAR,PSPOINT,PSSIVID,SYNIEN,XX,PSSCROSS,D

 ;Setting DRUGEDIT in next line because cross reference on GENERIC DRUG #1 Field of IV SOLUTION (#52.7) File needs it defined

 K PSSEDSDA,PSSEDSXX,PSSEDSZZ,PSSEDSDR,PSSEDSGG,PSSEDSAR S DRUGEDIT=1

 W ! K DIC,X,DTOUT,DUOUT S DIC="^PS(52.7,",DIC(0)="AEQMZ" D ^DIC K DIC,X I Y<0!($D(DUOUT))!($D(DTOUT)) D UN Q

 S PSSEDSDA=+Y,PSSEDSXX=$P($G(^PS(52.7,PSSEDSDA,0)),"^",11)

 K DIE,DA,DR S DIE="^PS(52.7,",DA=PSSEDSDA,DR=".01;.02;1;D GETD^PSSPRUTL;2;8;17;18" D ^DIE K DIE,DA,DR

 ;Change the Generic Drug could automatically change the Orderable Item of the IV Solution

 ;Now doing what MSF^PSSDFEE does, updating Orderable Items, though cross reference on 52.,7,1 should have already done it

 ;Just as a safeguard, we'll look to update all Orderable Items again, note that PSSEDSZZ and PSSEDSGG should never be different

 S PSSEDSZZ=$P($G(^PS(52.7,PSSEDSDA,0)),"^",11),PSSEDSDR=$P($G(^PS(52.7,PSSEDSDA,0)),"^",2),PSSEDSGG=$P($G(^PSDRUG(+PSSEDSDR,2)),"^")

 I PSSEDSZZ K PSSCROSS D EN^PSSPOIDT(PSSEDSZZ),EN2^PSSHL1(PSSEDSZZ,"MUP")

 I PSSEDSGG,PSSEDSGG'=PSSEDSZZ K PSSCROSS D EN^PSSPOIDT(PSSEDSGG),EN2^PSSHL1(PSSEDSGG,"MUP")

 ;I PSSEDSXX D EN^PSSPOIDT(PSSEDSXX),EN2^PSSHL1(PSSEDSXX,"MUP") S PSSEDSAR(PSSEDSXX)=""

 ;I PSSEDSZZ,'$D(PSSEDSAR(PSSEDSZZ)) D EN^PSSPOIDT(PSSEDSZZ),EN2^PSSHL1(PSSEDSZZ,"MUP") S PSSEDSAR(PSSEDSZZ)=""

 ;I PSSEDSGG,'$D(PSSEDSAR(PSSEDSGG)) D EN^PSSPOIDT(PSSEDSGG),EN2^PSSHL1(PSSEDSGG,"MUP") S PSSEDSAR(PSSEDSGG)=""

 W ! G EDITM

 ;D UN

UN ;Unlock File

 L -^PS(52.7)

GETD ;See if generic drug is inactive in file 50, code cloned from line tag GETD Of routine PSSVIDRG

 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 $P(^PS(52.7,PSSEDSDA,"I"),"^")=$P(^PSDRUG(X,"I"),"^")

MESS ;

 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR

PSSPRUTL  ;BIR/RTR-Edit IV Solution ;04/19/08

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67

 +2       ;

 +3       ;

EDIT      ;Edit IV Solution

 +1        NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,PSSEDSDA,PSSEDSXX,PSSEDSZZ,PSSEDSDR,PSSEDSGG,PSSEDSAR,DRUGEDIT

 +2       ;Newing D in next line because FileMan is leaving it defined to a zero node upon option exit

 +3        NEW %,%DT,D0,I,J,MSG,PSJCLEAR,PSPOINT,PSSIVID,SYNIEN,XX,PSSCROSS,D

 +4        IF '$DATA(^XUSEC("PSJI MGR",DUZ))

               WRITE !!!,"Sorry, you need the 'PSJI MGR' key to access this option.",!

               DO MESS

               QUIT

 +5        LOCK +^PS(52.7):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

 +6        IF '$TEST

               WRITE !!!,"Sorry, someone else is editing entries in the IV SOLUTIONS (#52.7) File.",!

               DO MESS

               QUIT

EDITM     ;

 +1        KILL X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,MSG,PSJCLEAR,PSPOINT,PSSIVID,SYNIEN,XX,PSSCROSS,D

 +2       ;Setting DRUGEDIT in next line because cross reference on GENERIC DRUG #1 Field of IV SOLUTION (#52.7) File needs it defined

 +3        KILL PSSEDSDA,PSSEDSXX,PSSEDSZZ,PSSEDSDR,PSSEDSGG,PSSEDSAR

           SET DRUGEDIT=1

 +4        WRITE !

           KILL DIC,X,DTOUT,DUOUT

           SET DIC="^PS(52.7,"

           SET DIC(0)="AEQMZ"

           DO ^DIC

           KILL DIC,X

           IF Y<0!($DATA(DUOUT))!($DATA(DTOUT))

               DO UN

               QUIT

 +5        SET PSSEDSDA=+Y

           SET PSSEDSXX=$PIECE($GET(^PS(52.7,PSSEDSDA,0)),"^",11)

 +6        KILL DIE,DA,DR

           SET DIE="^PS(52.7,"

           SET DA=PSSEDSDA

           SET DR=".01;.02;1;D GETD^PSSPRUTL;2;8;17;18"

           DO ^DIE

           KILL DIE,DA,DR

 +7       ;Change the Generic Drug could automatically change the Orderable Item of the IV Solution

 +8       ;Now doing what MSF^PSSDFEE does, updating Orderable Items, though cross reference on 52.,7,1 should have already done it

 +9       ;Just as a safeguard, we'll look to update all Orderable Items again, note that PSSEDSZZ and PSSEDSGG should never be different

 +10       SET PSSEDSZZ=$PIECE($GET(^PS(52.7,PSSEDSDA,0)),"^",11)

           SET PSSEDSDR=$PIECE($GET(^PS(52.7,PSSEDSDA,0)),"^",2)

           SET PSSEDSGG=$PIECE($GET(^PSDRUG(+PSSEDSDR,2)),"^")

 +11       IF PSSEDSZZ

               KILL PSSCROSS

               DO EN^PSSPOIDT(PSSEDSZZ)

               DO EN2^PSSHL1(PSSEDSZZ,"MUP")

 +12       IF PSSEDSGG

               IF PSSEDSGG'=PSSEDSZZ

                   KILL PSSCROSS

                   DO EN^PSSPOIDT(PSSEDSGG)

                   DO EN2^PSSHL1(PSSEDSGG,"MUP")

 +13      ;I PSSEDSXX D EN^PSSPOIDT(PSSEDSXX),EN2^PSSHL1(PSSEDSXX,"MUP") S PSSEDSAR(PSSEDSXX)=""

 +14      ;I PSSEDSZZ,'$D(PSSEDSAR(PSSEDSZZ)) D EN^PSSPOIDT(PSSEDSZZ),EN2^PSSHL1(PSSEDSZZ,"MUP") S PSSEDSAR(PSSEDSZZ)=""

 +15      ;I PSSEDSGG,'$D(PSSEDSAR(PSSEDSGG)) D EN^PSSPOIDT(PSSEDSGG),EN2^PSSHL1(PSSEDSGG,"MUP") S PSSEDSAR(PSSEDSGG)=""

 +16       WRITE !

           GOTO EDITM

 +17      ;D UN

 +18       QUIT

UN        ;Unlock File

 +1        LOCK -^PS(52.7)

 +2        QUIT

 +3       ;

GETD      ;See if generic drug is inactive in file 50, code cloned from line tag GETD Of routine PSSVIDRG

 +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 $PIECE(^PS(52.7,PSSEDSDA,"I"),"^")=$PIECE(^PSDRUG(X,"I"),"^")

 +2        QUIT

 +3       ;

MESS      ;

 +1        WRITE !

           KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press Return to Continue"

           DO ^DIR

           KILL DIR

 +2        QUIT

PSSPRUTL.m