PSSDFEE ;BIR/ASJ-VARIOUS FILES ENTER EDIT ROUTINE ;25-Sep-2013 11:33;DU
;;1.0;PHARMACY DATA MANAGEMENT;**38,48,125,129,1017**;9/30/97;Build 40
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,ZDATA,IN,SNOMED,PSSMRNM,FNUM,IENS,FDA,ERR
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
;IHS/MSC/MGH Patch 1017 Add Apelon lookup to map to SNOMED
W !,"Querying Apelon site..."
S PSSMRNM=$P($G(^PS(51.23,PSSDMRNW,0)),"^")
S IN=PSSMRNM_"^32774" S ZDATA=$$ASSOC^BSTSAPI(IN)
S SNOMED=$P(ZDATA,U,1)
S FNUM=51.2
S IENS=PSSDMREN_","
S FDA=$NA(FDA(FNUM,IENS))
S @FDA@(9999999.01)=SNOMED
D FILE^DIE("E","FDA","ERR")
I '$D(ERR) W !,"SNOMED Added "_SNOMED
;end mod
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
;IHS/MSC/MGH Patch 1017 Display the Snomed code
SNO(DA) Q $$GET1^DIQ(51.2,DA,9999999.01)
;
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
PSSDFEE ;BIR/ASJ-VARIOUS FILES ENTER EDIT ROUTINE ;25-Sep-2013 11:33;DU
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38,48,125,129,1017**;9/30/97;Build 40
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,ZDATA,IN,SNOMED,PSSMRNM,FNUM,IENS,FDA,ERR
+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 ;IHS/MSC/MGH Patch 1017 Add Apelon lookup to map to SNOMED
+12 WRITE !,"Querying Apelon site..."
+13 SET PSSMRNM=$PIECE($GET(^PS(51.23,PSSDMRNW,0)),"^")
+14 SET IN=PSSMRNM_"^32774"
SET ZDATA=$$ASSOC^BSTSAPI(IN)
+15 SET SNOMED=$PIECE(ZDATA,U,1)
+16 SET FNUM=51.2
+17 SET IENS=PSSDMREN_","
+18 SET FDA=$NAME(FDA(FNUM,IENS))
+19 SET @FDA@(9999999.01)=SNOMED
+20 DO FILE^DIE("E","FDA","ERR")
+21 IF '$DATA(ERR)
WRITE !,"SNOMED Added "_SNOMED
+22 ;end mod
+23 SET PSSDMRFL=0
IF PSSDMRA
IF PSSDMRNW
IF PSSDMRA'=PSSDMRNW
SET PSSDMRFL=1
+24 IF PSSDMRA
IF PSSDMRNW
IF 'PSSDMRFL
Begin DoDot:1
+25 WRITE !!,"No mapping changes made.",!
+26 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
+27 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)_"'",!
+28 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
+29 QUIT
+30 ;IHS/MSC/MGH Patch 1017 Display the Snomed code
SNO(DA) QUIT $$GET1^DIQ(51.2,DA,9999999.01)
+1 ;
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
