PSSDFEE ;BIR/ASJ-VARIOUS FILES ENTER EDIT ROUTINE ;01/21/00
;;1.0;PHARMACY DATA MANAGEMENT;**38,48,125,129**;9/30/97;Build 67
DF ;Dosage File Enter/Edit
D ^PSSDEE2 N DIC,PSSDF,DLAYGO,PSSREC,X,Y,D,%,%X,%Y,DIE,DA,DR,DIR,DTOUT,DUOUT,DIROUT,DIRUT,D0
F W !! S DIC(0)="QEAMZ",DIC="^PS(50.606,",DIC("S")="I '$P(^(0),""^"",2)!($P(^(0),""^"",2)>DT)" D ^DIC S PSSREC=+Y Q:PSSREC<0 W !!,"NAME: ",Y(0,0) D EDT(DIC,PSSREC,"[PSS DOSAGE FORM]",50.606)
W ! Q
MR ;Medication Routes File Enter/Edit
D ^PSSDEE2 N DIC,PSSDF,DLAYGO,PSSDMRA,PSSREC,X,Y,D,%,%X,%Y,PSSDMRQT,DIE,DA,DR,DIR,DTOUT,DUOUT,DIROUT,DIRUT,PSSDMREN,D0
S PSSDMRQT=0 F Q:PSSDMRQT W !! S DIC(0)="QEAMZIL",DIC="^PS(51.2,",DLAYGO=51.2 D ^DIC Q:Y<0 S (PSSREC,PSSDMREN)=+Y S PSSDMRA=$P($G(^PS(51.2,PSSREC,1)),"^") D EDT(DIC,PSSREC,"[PSS MEDICATION ROUTES]",51.2)
W ! Q
CF ;Rx Consult File
Q
; It was decided not to put this functionality in PSS*1*38
D ^PSSDEE2 N DIC,PSSDF,DLAYGO
F W !! S DIC(0)="QEAMZIL",DIC="^PS(54,",DLAYGO=54 D ^DIC Q:Y<0 S PSSREC=+Y D EDT(DIC,PSSREC,"[PSS RX CONSULT]",54)
W @IOF Q
;
EDT(DIE,DA,DR,PSFILE) ;
N PSREC S PSREC=DA
L +^PS(PSFILE,PSREC):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
I '$T W !!,$C(7),"Another person is editing this entry." Q
K DTOUT D ^DIE
I PSFILE=51.2 I $D(Y)!($D(DTOUT)) D:'$P($G(^PS(51.2,PSSDMREN,1)),"^")&($P($G(^PS(51.2,PSSDMREN,0)),"^",4)) MESS L -^PS(PSFILE,PSREC) Q
K DIE,DR,DA,Y
I PSFILE=51.2 D STN
L -^PS(PSFILE,PSREC)
Q
;
STN ;Standard Med Route Mapping
N PSSDMRX,PSSDMRNW,PSSDMRFL
I '$P($G(^PS(51.2,PSSDMREN,0)),"^",4) Q
I PSSDMRA S PSSDMRX=0 D I PSSDMRX Q:PSSDMRQT W !!,"Mapping Remains Unchanged.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) PSSDMRQT=1 Q
.W !!,"Already mapped to:",!,"Stnd Route: '"_$P($G(^PS(51.23,PSSDMRA,0)),"^")_"' FDB Route: '"_$P($G(^PS(51.23,PSSDMRA,0)),"^",2)_"'"
.W ! K DIR,Y S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to remap to a different Standard Med Route"
.S DIR("?")=" ",DIR("?",1)="Enter 'Y' to map to a different Standard Med Route,",DIR("?",2)="enter 'N' or Press <ret> to not change this mapping."
.K DTOUT,DUOUT D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) PSSDMRQT=1 I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSSDMRX=1
W ! S DA=PSSDMREN,DIE="^PS(51.2,",DR=10 D ^DIE I $D(Y)!($D(DTOUT)) D:'$P($G(^PS(51.2,PSSDMREN,1)),"^") MESSA W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) PSSDMRQT=1 Q
S PSSDMRNW=$P($G(^PS(51.2,PSSDMREN,1)),"^")
I 'PSSDMRNW D MESS Q
S PSSDMRFL=0 I PSSDMRA,PSSDMRNW,PSSDMRA'=PSSDMRNW S PSSDMRFL=1
I PSSDMRA,PSSDMRNW,'PSSDMRFL D W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSSDMRQT=1 K DIR Q
.W !!,"No mapping changes made.",!
.W !,"Local Route: '"_$P($G(^PS(51.2,PSSDMREN,0)),"^")_"' remains mapped to",!,"Stnd Route: '"_$P($G(^PS(51.23,PSSDMRNW,0)),"^")_"' FDB Route: '"_$P($G(^(0)),"^",2)_"'"
W !!!,"Local Route: '"_$P($G(^PS(51.2,PSSDMREN,0)),"^")_"' has been "_$S(PSSDMRFL:"remapped",1:"mapped")_" to",!,"Stnd Route: '"_$P($G(^PS(51.23,PSSDMRNW,0)),"^")_"' FDB Route: '"_$P($G(^(0)),"^",2)_"'",!
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSSDMRQT=1 K DIR
Q
;
MESS ;
W !!!," *** No dosing checks will be performed on orders containing this local",!," medication route until it is mapped to a standard medication route.***",!
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSSDMRQT=1 K DIR
Q
MESSA ;
W !!!," *** No dosing checks will be performed on orders containing this local",!," medication route until it is mapped to a standard medication route.***",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDFEE 3823 printed Apr 09, 2024@21:36:55 Page 2
PSSDFEE ;BIR/ASJ-VARIOUS FILES ENTER EDIT ROUTINE ;01/21/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38,48,125,129**;9/30/97;Build 67
DF ;Dosage File Enter/Edit
+1 DO ^PSSDEE2
NEW DIC,PSSDF,DLAYGO,PSSREC,X,Y,D,%,%X,%Y,DIE,DA,DR,DIR,DTOUT,DUOUT,DIROUT,DIRUT,D0
+2 FOR
WRITE !!
SET DIC(0)="QEAMZ"
SET DIC="^PS(50.606,"
SET DIC("S")="I '$P(^(0),""^"",2)!($P(^(0),""^"",2)>DT)"
DO ^DIC
SET PSSREC=+Y
if PSSREC<0
QUIT
WRITE !!,"NAME: ",Y(0,0)
DO EDT(DIC,PSSREC,"[PSS DOSAGE FORM]",50.606)
+3 WRITE !
QUIT
MR ;Medication Routes File Enter/Edit
+1 DO ^PSSDEE2
NEW DIC,PSSDF,DLAYGO,PSSDMRA,PSSREC,X,Y,D,%,%X,%Y,PSSDMRQT,DIE,DA,DR,DIR,DTOUT,DUOUT,DIROUT,DIRUT,PSSDMREN,D0
+2 SET PSSDMRQT=0
FOR
if PSSDMRQT
QUIT
WRITE !!
SET DIC(0)="QEAMZIL"
SET DIC="^PS(51.2,"
SET DLAYGO=51.2
DO ^DIC
if Y<0
QUIT
SET (PSSREC,PSSDMREN)=+Y
SET PSSDMRA=$PIECE($GET(^PS(51.2,PSSREC,1)),"^")
DO EDT(DIC,PSSREC,"[PSS MEDICATION ROUTES]",51.2)
+3 WRITE !
QUIT
CF ;Rx Consult File
+1 QUIT
+2 ; It was decided not to put this functionality in PSS*1*38
+3 DO ^PSSDEE2
NEW DIC,PSSDF,DLAYGO
+4 FOR
WRITE !!
SET DIC(0)="QEAMZIL"
SET DIC="^PS(54,"
SET DLAYGO=54
DO ^DIC
if Y<0
QUIT
SET PSSREC=+Y
DO EDT(DIC,PSSREC,"[PSS RX CONSULT]",54)
+5 WRITE @IOF
QUIT
+6 ;
EDT(DIE,DA,DR,PSFILE) ;
+1 NEW PSREC
SET PSREC=DA
+2 LOCK +^PS(PSFILE,PSREC):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
+3 IF '$TEST
WRITE !!,$CHAR(7),"Another person is editing this entry."
QUIT
+4 KILL DTOUT
DO ^DIE
+5 IF PSFILE=51.2
IF $DATA(Y)!($DATA(DTOUT))
if '$PIECE($GET(^PS(51.2,PSSDMREN,1)),"^")&($PIECE($GET(^PS(51.2,PSSDMREN,0)),"^",4))
DO MESS
LOCK -^PS(PSFILE,PSREC)
QUIT
+6 KILL DIE,DR,DA,Y
+7 IF PSFILE=51.2
DO STN
+8 LOCK -^PS(PSFILE,PSREC)
+9 QUIT
+10 ;
STN ;Standard Med Route Mapping
+1 NEW PSSDMRX,PSSDMRNW,PSSDMRFL
+2 IF '$PIECE($GET(^PS(51.2,PSSDMREN,0)),"^",4)
QUIT
+3 IF PSSDMRA
SET PSSDMRX=0
Begin DoDot:1
+4 WRITE !!,"Already mapped to:",!,"Stnd Route: '"_$PIECE($GET(^PS(51.23,PSSDMRA,0)),"^")_"' FDB Route: '"_$PIECE($GET(^PS(51.23,PSSDMRA,0)),"^",2)_"'"
+5 WRITE !
KILL DIR,Y
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want to remap to a different Standard Med Route"
+6 SET DIR("?")=" "
SET DIR("?",1)="Enter 'Y' to map to a different Standard Med Route,"
SET DIR("?",2)="enter 'N' or Press <ret> to not change this mapping."
+7 KILL DTOUT,DUOUT
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET PSSDMRQT=1
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSSDMRX=1
End DoDot:1
IF PSSDMRX
if PSSDMRQT
QUIT
WRITE !!,"Mapping Remains Unchanged.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET PSSDMRQT=1
QUIT
+8 WRITE !
SET DA=PSSDMREN
SET DIE="^PS(51.2,"
SET DR=10
DO ^DIE
IF $DATA(Y)!($DATA(DTOUT))
if '$PIECE($GET(^PS(51.2,PSSDMREN,1)),"^")
DO MESSA
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET PSSDMRQT=1
QUIT
+9 SET PSSDMRNW=$PIECE($GET(^PS(51.2,PSSDMREN,1)),"^")
+10 IF 'PSSDMRNW
DO MESS
QUIT
+11 SET PSSDMRFL=0
IF PSSDMRA
IF PSSDMRNW
IF PSSDMRA'=PSSDMRNW
SET PSSDMRFL=1
+12 IF PSSDMRA
IF PSSDMRNW
IF 'PSSDMRFL
Begin DoDot:1
+13 WRITE !!,"No mapping changes made.",!
+14 WRITE !,"Local Route: '"_$PIECE($GET(^PS(51.2,PSSDMREN,0)),"^")_"' remains mapped to",!,"Stnd Route: '"_$PIECE($GET(^PS(51.23,PSSDMRNW,0)),"^")_"' FDB Route: '"_$PIECE($GET(^(0)),"^",2)_"'"
End DoDot:1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET PSSDMRQT=1
KILL DIR
QUIT
+15 WRITE !!!,"Local Route: '"_$PIECE($GET(^PS(51.2,PSSDMREN,0)),"^")_"' has been "_$SELECT(PSSDMRFL:"remapped",1:"mapped")_" to",!,"Stnd Route: '"_$PIECE($GET(^PS(51.23,PSSDMRNW,0)),"^")_"' FDB Route: '"_$PIECE($GET(^(0)),"^",2)_"'",!
+16 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET PSSDMRQT=1
KILL DIR
+17 QUIT
+18 ;
MESS ;
+1 WRITE !!!," *** No dosing checks will be performed on orders containing this local",!," medication route until it is mapped to a standard medication route.***",!
+2 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET PSSDMRQT=1
KILL DIR
+3 QUIT
MESSA ;
+1 WRITE !!!," *** No dosing checks will be performed on orders containing this local",!," medication route until it is mapped to a standard medication route.***",!
+2 QUIT
