- 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 Feb 18, 2025@23:59:05 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