PSSMEDRT ;BIR/RTR-Medication Route Utilities ;06/14/07
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
;
MATCH ;Match File 51.2 Med Routes to Standard Med Routes
;Mainly for use only for the initial set up of the 0.5 Order Checks
W !!,"This option will find local Medication Routes marked for 'ALL PACKAGES' not",!,"mapped to a Standard Medication Route, and prompt you to map the local route.",!
W "This mapping is necessary to perform Dosage checks.",!!,"Searching for unmapped Med Routes..."
N PSSMRLP,PSSMRLNN,PSSMRLFL,PSSMRLND,PSSMRLOK,PSSMRLAA,DIC,DIE,DA,DR,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S PSSMRLFL=0
S PSSMRLP="" F S PSSMRLP=$O(^PS(51.2,"B",PSSMRLP)) Q:PSSMRLP=""!(PSSMRLFL) F PSSMRLNN=0:0 S PSSMRLNN=$O(^PS(51.2,"B",PSSMRLP,PSSMRLNN)) Q:'PSSMRLNN!(PSSMRLFL) D
.K PSSMRLND,PSSMRLOK,PSSMRLAA,DIC,DIE,DA,DR,DIR,X,Y
.S PSSMRLND=$G(^PS(51.2,PSSMRLNN,0))
.I '$P(PSSMRLND,"^",4) Q
.I $P($G(^PS(51.2,PSSMRLNN,1)),"^") Q
.W !!!,"Mapping local Med Route of '"_$P(PSSMRLND,"^")_"'",!
.L +^PS(51.2,PSSMRLNN):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
.I '$T W !!,"Another person is editing this Med Route." D Q
..W ! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to continue mapping Med Routes",DIR("?")="Enter 'Y' to continue mapping Med Routes, enter 'N' or '^' to exit"
..D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSSMRLFL=1
.K DIC,DTOUT,DUOUT S DIC=51.23,DIC(0)="AEMQZ",DIC("W")="W "" FDB Route: ""_$P(^(0),""^"",2)"
.S DIC("S")="I '$$SCREEN^XTID(51.23,.01,+Y_"","")"
.D ^DIC K DIC
.I $D(DTOUT)!($D(DUOUT)) D D UNL Q
..W !! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to continue mapping Med Routes",DIR("?")="Enter 'Y' to continue mapping Med Routes, enter 'N' or '^' to exit"
..D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSSMRLFL=1
.I +Y'>0 D UNL Q
.S PSSMRLOK=+Y
.K DIE,DA,DR S DIE=51.2,DA=PSSMRLNN,DR="10////^S X=+PSSMRLOK" D ^DIE K DA,DIE,DR
.S PSSMRLAA=$P($G(^PS(51.2,PSSMRLNN,1)),"^")
.I 'PSSMRLAA W !!!,"Unable to make this match!!" D D UNL Q
..W ! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to continue mapping Med Routes",DIR("?")="Enter 'Y' to continue mapping Med Routes, enter 'N' or '^' to exit"
..D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSSMRLFL=1
.W !!!,"Local Route: '"_$P(PSSMRLND,"^")_"' has been mapped to",!,"Stnd Route: '"_$P($G(^PS(51.23,PSSMRLAA,0)),"^")_"' FDB Route: '"_$P($G(^(0)),"^",2)_"'"
.D UNL
W !!!,"Checking for any remaining unmapped Local Med Routes..."
S (PSSMRLFL,PSSMRLNN)=0
S PSSMRLP="" F S PSSMRLP=$O(^PS(51.2,"B",PSSMRLP)) Q:PSSMRLP=""!(PSSMRLFL) F PSSMRLNN=0:0 S PSSMRLNN=$O(^PS(51.2,"B",PSSMRLP,PSSMRLNN)) Q:'PSSMRLNN!(PSSMRLFL) D
.K PSSMRLND
.S PSSMRLND=$G(^PS(51.2,PSSMRLNN,0))
.I '$P(PSSMRLND,"^",4) Q
.I '$P($G(^PS(51.2,PSSMRLNN,1)),"^") S PSSMRLFL=1
I PSSMRLFL W !!!,"There are still local Med Routes marked for 'ALL PACKAGES' not yet mapped,",!,"see the 'Medication Route Mapping Report' option for more details.",!
I 'PSSMRLFL W !!!,"All Local Med Routes are mapped!",!
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
UNL ;Unlock Med Route
Q:'$G(PSSMRLNN)
L -^PS(51.2,PSSMRLNN)
Q
;
ONE ;Map one Local Medication Routes to Standard Route
N DIC,PSSMRB,PSSMRBA,PSSMRBAX,PSSMRBAZ,DA,DIQ,DIR,DIE,DR,PSSMRB1,PSSMRB2,PSSMRB3,PSSONEXT,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
ONEX ;
K DIC,PSSMRB,PSSMRBA,PSSMRBAX,PSSMRBAZ,DA,DIQ,DIR,DIE,DR,PSSMRB1,PSSMRB2,PSSMRB3,PSSONEXT
W ! K DIC,DTOUT,DUOUT S DIC=51.2,DIC(0)="QEAMZ",DIC("S")="I $P($G(^PS(51.2,+Y,0)),""^"",4)" D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT))!(+Y'>0) W ! Q
S (DA,PSSMRB)=+Y
K ^UTILITY("DIQ1",$J) K DIQ,PSSMRBA S DIC=51.2,DR="10",DIQ="PSSMRBA",DIQ(0)="EI" D EN^DIQ1
K ^UTILITY("DIQ1",$J) K DIQ
W !!!,$P($G(^PS(51.2,PSSMRB,0)),"^")
S PSSMRB1=$G(PSSMRBA(51.2,PSSMRB,10,"I"))
I $G(PSSMRBA(51.2,PSSMRB,10,"E"))'="" D I $G(PSSONEXT) G ONEX
.W !!,"Already mapped to:",!,"Stnd Route: '"_$G(PSSMRBA(51.2,PSSMRB,10,"E"))_"' FDB Route: '"_$P($G(^PS(51.23,+$G(PSSMRBA(51.2,PSSMRB,10,"I")),0)),"^",2)_"'"
.W ! K DIR,PSSONEXT 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 I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSSONEXT=1
L +^PS(51.2,PSSMRB):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
I '$T W !!,"Another person is editing this Med Route." D G ONEX
.W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
W ! K DIC,DTOUT,DUOUT S DIC=51.23,DIC(0)="AEMQZ",DIC("W")="W "" FDB Route: ""_$P(^(0),""^"",2)"
S DIC("S")="I '$$SCREEN^XTID(51.23,.01,+Y_"","")"
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT))!(+Y'>0) D D ONEUL G ONEX
.I $G(PSSMRBA(51.2,PSSMRB,10,"E"))'="" W !!,"Mapping remains unchanged.",! Q
.W !!,"Nothing mapped - No dosing checks will be performed on orders containing this",!,"local medication route until it is mapped to a standard medication route.",!
S (PSSMRBAX,PSSMRB2)=+Y
K DIE,DR,DA S DIE=51.2,DA=PSSMRB,DR="10////^S X=+PSSMRBAX" D ^DIE K DA,DIE,DR
S PSSMRBAZ=$P($G(^PS(51.2,PSSMRB,1)),"^")
I 'PSSMRBAZ W !!!,"Unable to make this match, Med Route is unmatched",! D D ONEUL G ONEX
.W !,"Nothing mapped - No dosing checks will be performed on orders containing this",!,"local medication route until it is mapped to a standard medication route.",!
S PSSMRB3=0 I PSSMRB1,PSSMRB2,PSSMRB1'=PSSMRB2 S PSSMRB3=1
W !!!,"Local Route: '"_$P($G(^PS(51.2,PSSMRB,0)),"^")_"' has been "_$S(PSSMRB3:"remapped",1:"mapped")_" to",!,"Stnd Route: '"_$P($G(^PS(51.23,PSSMRBAZ,0)),"^")_"' FDB Route: '"_$P($G(^(0)),"^",2)_"'",!
D ONEUL
G ONEX
Q
ONEUL ;Unlock Med route
Q:'$G(PSSMRB)
L -^PS(51.2,PSSMRB)
Q
REP ;Med Route Report
W !!!,"This report will print Medication Route mapping information for Medication",!,"Routes marked for ALL PACKAGES in the PACKAGE USE (#3) Field of the MEDICATION"
W !,"ROUTES (#51.2) File.",!
N DIR,PSSPTYPE,DUOUT,DTOUT,Y,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,X,DIRUT,DIROUT,ZTSK
K DIR,DUOUT,DTOUT S DIR(0)="SO^A:ALL MEDICATION ROUTES;O:ONLY UNMAPPED MEDICATION ROUTES",DIR("A")="Enter 'A' for All Routes, 'O' for Only Unmapped Routes",DIR("B")="O"
S DIR("?")=" ",DIR("?",1)="Enter 'A' to see All Medication Routes from the Medication Routes (#51.2) File",DIR("?",2)="along with the mapping information for the Routes that are mapped."
S DIR("?",3)="Enter 'O' to see a list of Only those Routes that have not yet been mapped."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) W !!,"No Action taken.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
I Y'="A",Y'="O" W !!,"No Action taken.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
S PSSPTYPE=Y
W !!?3,"This report is designed for 132 column format!",!
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 W !!,"No Action taken.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
I $D(IO("Q")) S ZTRTN="START^PSSMEDRT",ZTDESC="Medication Routes Mapping Report",ZTSAVE("PSSPTYPE")="" D ^%ZTLOAD W !!,"Report queued to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
U IO G STARTX
START ;
U IO
N DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
STARTX ;
N PSSTLINE,PSSTOUT,PSSTDV,PSSTCT,PSSMT,PSSMTI,PSSMTNAM,PSSMTMAP,PSSMTEXP,PSSMTCTA,PSSMTCTB,DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
S (PSSMTCTA,PSSMTCTB)=0
S PSSTOUT=0,PSSTDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSTCT=1
K PSSTLINE S $P(PSSTLINE,"-",130)=""
D HD
S PSSMT="" F S PSSMT=$O(^PS(51.2,"B",PSSMT)) Q:PSSMT=""!(PSSTOUT) D
.F PSSMTI=0:0 S PSSMTI=$O(^PS(51.2,"B",PSSMT,PSSMTI)) Q:'PSSMTI!(PSSTOUT) D
..I '$P($G(^PS(51.2,PSSMTI,0)),"^",4) Q
..S PSSMTNAM=$P($G(^PS(51.2,PSSMTI,0)),"^"),PSSMTEXP=$P($G(^PS(51.2,PSSMTI,0)),"^",2),PSSMTMAP=$P($G(^PS(51.2,PSSMTI,1)),"^")
..I PSSPTYPE="O",PSSMTMAP Q
..S PSSMTCTA=PSSMTCTA+1 I 'PSSMTMAP S PSSMTCTB=PSSMTCTB+1
..I PSSPTYPE="O" W !!,PSSMTNAM I PSSMTEXP'="" W !,?4,PSSMTEXP
..I PSSPTYPE'="O" W !!,PSSMTNAM,?47,$P($G(^PS(51.23,+PSSMTMAP,0)),"^"),?100,$P($G(^PS(51.23,+PSSMTMAP,0)),"^",2) I PSSMTEXP'="" W !,?4,PSSMTEXP
..K PSSMTNAM,PSSMTEXP,PSSMTMAP
..I ($Y+5)>IOSL D HD Q:PSSTOUT
I 'PSSTOUT D
.D HD
.I PSSTOUT Q
.I PSSPTYPE="O" W !!,"TOTAL UNMAPPED MEDICATION ROUTES = "_$G(PSSMTCTB)
.I PSSPTYPE'="O" W !!,"TOTAL LOCAL MEDICATION ROUTES = "_$G(PSSMTCTA),!,"TOTAL UNMAPPED LOCAL MEDICATION ROUTES = "_$G(PSSMTCTB)
END ;
K PSSPTYPE
I $G(PSSTDV)="P" W !!,"End of Report."
I '$G(PSSTOUT),$G(PSSTDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSSTDV)="C" W !
E W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
HD ;
I $G(PSSTDV)="C",$G(PSSTCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSTOUT=1 Q
W @IOF W !,$S(PSSPTYPE="O":"MEDICATION ROUTES MAPPING EXCEPTION REPORT",1:"MEDICATION ROUTES MAPPING REPORT"),?114,"Page: "_$G(PSSTCT) S PSSTCT=PSSTCT+1
I PSSPTYPE="O" W !!,"MEDICATION ROUTES (File 51.2)"
I PSSPTYPE'="O" W !!,"MEDICATION ROUTES (File 51.2)",?47,"STANDARD ROUTE",?100,"FDB ROUTE"
W !?4,"OUTPATIENT EXPANSION",!,PSSTLINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMEDRT 9377 printed Sep 23, 2025@20:08:44 Page 2
PSSMEDRT ;BIR/RTR-Medication Route Utilities ;06/14/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
+2 ;
MATCH ;Match File 51.2 Med Routes to Standard Med Routes
+1 ;Mainly for use only for the initial set up of the 0.5 Order Checks
+2 WRITE !!,"This option will find local Medication Routes marked for 'ALL PACKAGES' not",!,"mapped to a Standard Medication Route, and prompt you to map the local route.",!
+3 WRITE "This mapping is necessary to perform Dosage checks.",!!,"Searching for unmapped Med Routes..."
+4 NEW PSSMRLP,PSSMRLNN,PSSMRLFL,PSSMRLND,PSSMRLOK,PSSMRLAA,DIC,DIE,DA,DR,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+5 SET PSSMRLFL=0
+6 SET PSSMRLP=""
FOR
SET PSSMRLP=$ORDER(^PS(51.2,"B",PSSMRLP))
if PSSMRLP=""!(PSSMRLFL)
QUIT
FOR PSSMRLNN=0:0
SET PSSMRLNN=$ORDER(^PS(51.2,"B",PSSMRLP,PSSMRLNN))
if 'PSSMRLNN!(PSSMRLFL)
QUIT
Begin DoDot:1
+7 KILL PSSMRLND,PSSMRLOK,PSSMRLAA,DIC,DIE,DA,DR,DIR,X,Y
+8 SET PSSMRLND=$GET(^PS(51.2,PSSMRLNN,0))
+9 IF '$PIECE(PSSMRLND,"^",4)
QUIT
+10 IF $PIECE($GET(^PS(51.2,PSSMRLNN,1)),"^")
QUIT
+11 WRITE !!!,"Mapping local Med Route of '"_$PIECE(PSSMRLND,"^")_"'",!
+12 LOCK +^PS(51.2,PSSMRLNN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
+13 IF '$TEST
WRITE !!,"Another person is editing this Med Route."
Begin DoDot:2
+14 WRITE !
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Do you want to continue mapping Med Routes"
SET DIR("?")="Enter 'Y' to continue mapping Med Routes, enter 'N' or '^' to exit"
+15 DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSSMRLFL=1
End DoDot:2
QUIT
+16 KILL DIC,DTOUT,DUOUT
SET DIC=51.23
SET DIC(0)="AEMQZ"
SET DIC("W")="W "" FDB Route: ""_$P(^(0),""^"",2)"
+17 SET DIC("S")="I '$$SCREEN^XTID(51.23,.01,+Y_"","")"
+18 DO ^DIC
KILL DIC
+19 IF $DATA(DTOUT)!($DATA(DUOUT))
Begin DoDot:2
+20 WRITE !!
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Do you want to continue mapping Med Routes"
SET DIR("?")="Enter 'Y' to continue mapping Med Routes, enter 'N' or '^' to exit"
+21 DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSSMRLFL=1
End DoDot:2
DO UNL
QUIT
+22 IF +Y'>0
DO UNL
QUIT
+23 SET PSSMRLOK=+Y
+24 KILL DIE,DA,DR
SET DIE=51.2
SET DA=PSSMRLNN
SET DR="10////^S X=+PSSMRLOK"
DO ^DIE
KILL DA,DIE,DR
+25 SET PSSMRLAA=$PIECE($GET(^PS(51.2,PSSMRLNN,1)),"^")
+26 IF 'PSSMRLAA
WRITE !!!,"Unable to make this match!!"
Begin DoDot:2
+27 WRITE !
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Do you want to continue mapping Med Routes"
SET DIR("?")="Enter 'Y' to continue mapping Med Routes, enter 'N' or '^' to exit"
+28 DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSSMRLFL=1
End DoDot:2
DO UNL
QUIT
+29 WRITE !!!,"Local Route: '"_$PIECE(PSSMRLND,"^")_"' has been mapped to",!,"Stnd Route: '"_$PIECE($GET(^PS(51.23,PSSMRLAA,0)),"^")_"' FDB Route: '"_$PIECE($GET(^(0)),"^",2)_"'"
+30 DO UNL
End DoDot:1
+31 WRITE !!!,"Checking for any remaining unmapped Local Med Routes..."
+32 SET (PSSMRLFL,PSSMRLNN)=0
+33 SET PSSMRLP=""
FOR
SET PSSMRLP=$ORDER(^PS(51.2,"B",PSSMRLP))
if PSSMRLP=""!(PSSMRLFL)
QUIT
FOR PSSMRLNN=0:0
SET PSSMRLNN=$ORDER(^PS(51.2,"B",PSSMRLP,PSSMRLNN))
if 'PSSMRLNN!(PSSMRLFL)
QUIT
Begin DoDot:1
+34 KILL PSSMRLND
+35 SET PSSMRLND=$GET(^PS(51.2,PSSMRLNN,0))
+36 IF '$PIECE(PSSMRLND,"^",4)
QUIT
+37 IF '$PIECE($GET(^PS(51.2,PSSMRLNN,1)),"^")
SET PSSMRLFL=1
End DoDot:1
+38 IF PSSMRLFL
WRITE !!!,"There are still local Med Routes marked for 'ALL PACKAGES' not yet mapped,",!,"see the 'Medication Route Mapping Report' option for more details.",!
+39 IF 'PSSMRLFL
WRITE !!!,"All Local Med Routes are mapped!",!
+40 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+41 QUIT
UNL ;Unlock Med Route
+1 if '$GET(PSSMRLNN)
QUIT
+2 LOCK -^PS(51.2,PSSMRLNN)
+3 QUIT
+4 ;
ONE ;Map one Local Medication Routes to Standard Route
+1 NEW DIC,PSSMRB,PSSMRBA,PSSMRBAX,PSSMRBAZ,DA,DIQ,DIR,DIE,DR,PSSMRB1,PSSMRB2,PSSMRB3,PSSONEXT,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
ONEX ;
+1 KILL DIC,PSSMRB,PSSMRBA,PSSMRBAX,PSSMRBAZ,DA,DIQ,DIR,DIE,DR,PSSMRB1,PSSMRB2,PSSMRB3,PSSONEXT
+2 WRITE !
KILL DIC,DTOUT,DUOUT
SET DIC=51.2
SET DIC(0)="QEAMZ"
SET DIC("S")="I $P($G(^PS(51.2,+Y,0)),""^"",4)"
DO ^DIC
KILL DIC
+3 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
WRITE !
QUIT
+4 SET (DA,PSSMRB)=+Y
+5 KILL ^UTILITY("DIQ1",$JOB)
KILL DIQ,PSSMRBA
SET DIC=51.2
SET DR="10"
SET DIQ="PSSMRBA"
SET DIQ(0)="EI"
DO EN^DIQ1
+6 KILL ^UTILITY("DIQ1",$JOB)
KILL DIQ
+7 WRITE !!!,$PIECE($GET(^PS(51.2,PSSMRB,0)),"^")
+8 SET PSSMRB1=$GET(PSSMRBA(51.2,PSSMRB,10,"I"))
+9 IF $GET(PSSMRBA(51.2,PSSMRB,10,"E"))'=""
Begin DoDot:1
+10 WRITE !!,"Already mapped to:",!,"Stnd Route: '"_$GET(PSSMRBA(51.2,PSSMRB,10,"E"))_"' FDB Route: '"_$PIECE($GET(^PS(51.23,+$GET(PSSMRBA(51.2,PSSMRB,10,"I")),0)),"^",2)_"'"
+11 WRITE !
KILL DIR,PSSONEXT
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want to remap to a different Standard Med Route"
+12 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."
+13 KILL DTOUT,DUOUT
DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSSONEXT=1
End DoDot:1
IF $GET(PSSONEXT)
GOTO ONEX
+14 LOCK +^PS(51.2,PSSMRB):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
+15 IF '$TEST
WRITE !!,"Another person is editing this Med Route."
Begin DoDot:1
+16 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
GOTO ONEX
+17 WRITE !
KILL DIC,DTOUT,DUOUT
SET DIC=51.23
SET DIC(0)="AEMQZ"
SET DIC("W")="W "" FDB Route: ""_$P(^(0),""^"",2)"
+18 SET DIC("S")="I '$$SCREEN^XTID(51.23,.01,+Y_"","")"
+19 DO ^DIC
KILL DIC
+20 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
Begin DoDot:1
+21 IF $GET(PSSMRBA(51.2,PSSMRB,10,"E"))'=""
WRITE !!,"Mapping remains unchanged.",!
QUIT
+22 WRITE !!,"Nothing mapped - No dosing checks will be performed on orders containing this",!,"local medication route until it is mapped to a standard medication route.",!
End DoDot:1
DO ONEUL
GOTO ONEX
+23 SET (PSSMRBAX,PSSMRB2)=+Y
+24 KILL DIE,DR,DA
SET DIE=51.2
SET DA=PSSMRB
SET DR="10////^S X=+PSSMRBAX"
DO ^DIE
KILL DA,DIE,DR
+25 SET PSSMRBAZ=$PIECE($GET(^PS(51.2,PSSMRB,1)),"^")
+26 IF 'PSSMRBAZ
WRITE !!!,"Unable to make this match, Med Route is unmatched",!
Begin DoDot:1
+27 WRITE !,"Nothing mapped - No dosing checks will be performed on orders containing this",!,"local medication route until it is mapped to a standard medication route.",!
End DoDot:1
DO ONEUL
GOTO ONEX
+28 SET PSSMRB3=0
IF PSSMRB1
IF PSSMRB2
IF PSSMRB1'=PSSMRB2
SET PSSMRB3=1
+29 WRITE !!!,"Local Route: '"_$PIECE($GET(^PS(51.2,PSSMRB,0)),"^")_"' has been "_$SELECT(PSSMRB3:"remapped",1:"mapped")_" to",!,"Stnd Route: '"_$PIECE($GET(^PS(51.23,PSSMRBAZ,0)),"^")_"' FDB Route: '"_$PIECE($GET(^(0)),"^",2)_"'",!
+30 DO ONEUL
+31 GOTO ONEX
+32 QUIT
ONEUL ;Unlock Med route
+1 if '$GET(PSSMRB)
QUIT
+2 LOCK -^PS(51.2,PSSMRB)
+3 QUIT
REP ;Med Route Report
+1 WRITE !!!,"This report will print Medication Route mapping information for Medication",!,"Routes marked for ALL PACKAGES in the PACKAGE USE (#3) Field of the MEDICATION"
+2 WRITE !,"ROUTES (#51.2) File.",!
+3 NEW DIR,PSSPTYPE,DUOUT,DTOUT,Y,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,X,DIRUT,DIROUT,ZTSK
+4 KILL DIR,DUOUT,DTOUT
SET DIR(0)="SO^A:ALL MEDICATION ROUTES;O:ONLY UNMAPPED MEDICATION ROUTES"
SET DIR("A")="Enter 'A' for All Routes, 'O' for Only Unmapped Routes"
SET DIR("B")="O"
+5 SET DIR("?")=" "
SET DIR("?",1)="Enter 'A' to see All Medication Routes from the Medication Routes (#51.2) File"
SET DIR("?",2)="along with the mapping information for the Routes that are mapped."
+6 SET DIR("?",3)="Enter 'O' to see a list of Only those Routes that have not yet been mapped."
+7 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
WRITE !!,"No Action taken.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+8 IF Y'="A"
IF Y'="O"
WRITE !!,"No Action taken.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+9 SET PSSPTYPE=Y
+10 WRITE !!?3,"This report is designed for 132 column format!",!
+11 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)>0
WRITE !!,"No Action taken.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,IOP,%ZIS,POP
QUIT
+12 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSMEDRT"
SET ZTDESC="Medication Routes Mapping Report"
SET ZTSAVE("PSSPTYPE")=""
DO ^%ZTLOAD
WRITE !!,"Report queued to print.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,IOP,%ZIS,POP
QUIT
+13 USE IO
GOTO STARTX
START ;
+1 USE IO
+2 NEW DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
STARTX ;
+1 NEW PSSTLINE,PSSTOUT,PSSTDV,PSSTCT,PSSMT,PSSMTI,PSSMTNAM,PSSMTMAP,PSSMTEXP,PSSMTCTA,PSSMTCTB,DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
+2 SET (PSSMTCTA,PSSMTCTB)=0
+3 SET PSSTOUT=0
SET PSSTDV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
SET PSSTCT=1
+4 KILL PSSTLINE
SET $PIECE(PSSTLINE,"-",130)=""
+5 DO HD
+6 SET PSSMT=""
FOR
SET PSSMT=$ORDER(^PS(51.2,"B",PSSMT))
if PSSMT=""!(PSSTOUT)
QUIT
Begin DoDot:1
+7 FOR PSSMTI=0:0
SET PSSMTI=$ORDER(^PS(51.2,"B",PSSMT,PSSMTI))
if 'PSSMTI!(PSSTOUT)
QUIT
Begin DoDot:2
+8 IF '$PIECE($GET(^PS(51.2,PSSMTI,0)),"^",4)
QUIT
+9 SET PSSMTNAM=$PIECE($GET(^PS(51.2,PSSMTI,0)),"^")
SET PSSMTEXP=$PIECE($GET(^PS(51.2,PSSMTI,0)),"^",2)
SET PSSMTMAP=$PIECE($GET(^PS(51.2,PSSMTI,1)),"^")
+10 IF PSSPTYPE="O"
IF PSSMTMAP
QUIT
+11 SET PSSMTCTA=PSSMTCTA+1
IF 'PSSMTMAP
SET PSSMTCTB=PSSMTCTB+1
+12 IF PSSPTYPE="O"
WRITE !!,PSSMTNAM
IF PSSMTEXP'=""
WRITE !,?4,PSSMTEXP
+13 IF PSSPTYPE'="O"
WRITE !!,PSSMTNAM,?47,$PIECE($GET(^PS(51.23,+PSSMTMAP,0)),"^"),?100,$PIECE($GET(^PS(51.23,+PSSMTMAP,0)),"^",2)
IF PSSMTEXP'=""
WRITE !,?4,PSSMTEXP
+14 KILL PSSMTNAM,PSSMTEXP,PSSMTMAP
+15 IF ($Y+5)>IOSL
DO HD
if PSSTOUT
QUIT
End DoDot:2
End DoDot:1
+16 IF 'PSSTOUT
Begin DoDot:1
+17 DO HD
+18 IF PSSTOUT
QUIT
+19 IF PSSPTYPE="O"
WRITE !!,"TOTAL UNMAPPED MEDICATION ROUTES = "_$GET(PSSMTCTB)
+20 IF PSSPTYPE'="O"
WRITE !!,"TOTAL LOCAL MEDICATION ROUTES = "_$GET(PSSMTCTA),!,"TOTAL UNMAPPED LOCAL MEDICATION ROUTES = "_$GET(PSSMTCTB)
End DoDot:1
END ;
+1 KILL PSSPTYPE
+2 IF $GET(PSSTDV)="P"
WRITE !!,"End of Report."
+3 IF '$GET(PSSTOUT)
IF $GET(PSSTDV)="C"
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+4 IF $GET(PSSTDV)="C"
WRITE !
+5 IF '$TEST
WRITE @IOF
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
HD ;
+1 IF $GET(PSSTDV)="C"
IF $GET(PSSTCT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSTOUT=1
QUIT
+2 WRITE @IOF
WRITE !,$SELECT(PSSPTYPE="O":"MEDICATION ROUTES MAPPING EXCEPTION REPORT",1:"MEDICATION ROUTES MAPPING REPORT"),?114,"Page: "_$GET(PSSTCT)
SET PSSTCT=PSSTCT+1
+3 IF PSSPTYPE="O"
WRITE !!,"MEDICATION ROUTES (File 51.2)"
+4 IF PSSPTYPE'="O"
WRITE !!,"MEDICATION ROUTES (File 51.2)",?47,"STANDARD ROUTE",?100,"FDB ROUTE"
+5 WRITE !?4,"OUTPATIENT EXPANSION",!,PSSTLINE
+6 QUIT
