PSSJORDF ;BIR/MV-RETURN MED ROUTES(MR) AND INSTRUCTIONS(INS) ;06/26/98
;;1.0;PHARMACY DATA MANAGEMENT;**5,13,34,38,69,113,94,140**;9/30/97;Build 9
;;
; Reference to ^PS(50.7 is supported by DBIA 2180.
; Reference to ^PS(51.2 is supported by DBIA 2178.
; Reference to ^PS(50.606 is supported by DBIA 2174.
;
;* PSJORD is the Orderable Item IEN pass to Pharmacy by OE/RR.
;* 1. If the dosage form is valid, this routine will return all med
;* routes and instructions associated with that dose form.
;* 2. If the dose form is null, this routine will return all med routes
;* that exist in the medication routes file.
;* 3. ^TMP format:
;* ^TMP("PSJMR",$J,#)=MED ROUTE^MED ROUTE ABREVATION^IEN^OUTPATIENT
;* EXPANSION^IV FLAG^DEFAULT FLAG
;* ^TMP("PSJNOUN",$J,D0)=NOUN^VERB^PREPOSITION
;* ^TMP("PSJSCH",$J)=DEFAULT SCHEDULE NAME
;
START(PSJORD,PSJOPAC) ;
NEW MR,MRNODE,INS,PSJDFNO,X,MCT,Z,PSJOISC
I '+PSJORD D MEDROUTE Q
S PSJDFNO=+$P($G(^PS(50.7,+PSJORD,0)),U,2)
S PSJOISC=$P($G(^PS(50.7,+PSJORD,0)),"^",8)
I $G(PSJOPAC)="O"!($G(PSJOPAC)="X") D:$G(PSJOISC)'="" EN^PSSOUTSC(.PSJOISC) S:$G(PSJOISC)'="" ^TMP("PSJSCH",$J)=$G(PSJOISC) G SCPASS
I $G(PSJOISC)'="" D EN^PSSGSGUI(.PSJOISC,"I") S:$G(PSJOISC)'="" ^TMP("PSJSCH",$J)=$G(PSJOISC)
SCPASS ;
I $G(^PS(50.606,PSJDFNO,0))="" D NOD Q:$D(^TMP("PSJMR",$J,1)) D MEDROUTE Q
K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J)
D DF
Q
;
DF ;* Loop thru DF node to find all available med routes, nouns, and instructions.
N VERB,MR,INS,X
S (MR,INS,X,MCT)=0
S VERB=$P($G(^PS(50.606,PSJDFNO,"MISC")),U)
;PSS*1*140 - If the orderable item has a default med route, send it back to CPRS
;as the only med route in ^TMP("PSJMR", otherwise use existing functionality.
;Check PHARMACY SYSTEM File (#59.7) to see if the site has set the
;parameter to use this functionality. 1 = yes, anything else = no
S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P($G(^(0)),"^",4)=1 S ^TMP("PSJMR",$J,1)=$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_MR_U_$P(^(0),"^",2)_U_$S($P(^(0),"^",6):1,1:0)_"^D",MCT=MCT+1 I $P($G(^PS(59.7,1,80)),"^",7)=1 Q
S MR=0 F S MR=$O(^PS(50.606,PSJDFNO,"MR",MR)) Q:'MR D
. S X=+$G(^PS(50.606,PSJDFNO,"MR",MR,0)) Q:'X!($P($G(^TMP("PSJMR",$J,1)),"^",3)=X)
. S MRNODE=$G(^PS(51.2,X,0))
. I $P($G(MRNODE),"^",4)'=1 Q
. S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_X_U_$P(MRNODE,U,2)_U_$S($P(MRNODE,U,6):1,1:0)
S X=0
I $D(^PS(50.606,PSJDFNO,"NOUN")) F Z=0:0 S Z=$O(^PS(50.606,PSJDFNO,"NOUN",Z)) Q:'Z S X=X+1,^TMP("PSJNOUN",$J,X)=$P($G(^PS(50.606,PSJDFNO,"NOUN",Z,0)),U)_U_$P($G(^PS(50.606,PSJDFNO,"MISC")),U)_U_$P($G(^("MISC")),U,3)
Q
;
MEDROUTE ;* Return all med routes in the med routes file.
S (MR,MCT)=0 K ^TMP("PSJMR",$J)
F S MR=$O(^PS(51.2,MR)) Q:'MR S MRNODE=^PS(51.2,MR,0) I $P(^PS(51.2,MR,0),"^",4)=1 S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_MR_U_$P(MRNODE,U,2)_U_$S($P(MRNODE,U,6):1,1:0)
Q
NOD K ^TMP("PSJMR",$J)
S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P(^PS(51.2,MR,0),"^",4)=1 S ^TMP("PSJMR",$J,1)=$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_MR_U_$P(^(0),"^",2)_U_$S($P(^(0),"^",6):1,1:0)_"^D"
Q
START1(PSJORD,PSJQOF) ;Entry point for IV dialog PSS*1*94
; This is the new entry point for the IV Dialog box from CPRS GUI 27. PSJORD will be an array
; sent by CPRS that contains all the IENS for all orderable items that are part of the order. The zero node of the array
; will contain the total number of orderable items in the order.
;
; PSJQOF is the quick order flag. 0=not a quick order 1=quick order
;
; If there is only one orderable item, any default defined in the Pharmacy Orderable Item file (50.7) will be
; marked with a D at the end of the data string.
;
; If there is more than one orderable item in the order, no default will be sent, and a union (the overlapping)
; of the med routes will be returned. For example if Dextrose can be given IV or IM, and the Ampicillin is only
; given IM, IM is the only med route that will be returned because it is the only overlapping med route between
; the two orderable items. If there is no overlapping med route to be returned, then a NULL will be returned to CPRS.
;
; If the quick order flag PSJQOF is set to 1, then CPRS is expecting the overlapping med routes for the orderable items
; as well as the entire list of med routes that are flagged for IV's.
;
I PSJQOF="" S PSJQOF=0
K PSJORD1,^TMP("PSJMR",$J)
I $G(PSJORD(0))=1 S PSJOPAC="I" D Q
. S PSJORD=$P($G(PSJORD(1)),"^",1)
. D MEDRT(PSJORD)
. I PSJQOF=1 S MCT=$O(^TMP("PSJMR",$J,"A"),-1) D ALLMED(MCT)
. M PSJORD1=^TMP("PSJMR",$J)
. D REMDUP
. K PSJORD
. M PSJORD=PSJORD1
. K PSJORD1,^TMP("PSJMR",$J)
S X=0
F S X=$O(PSJORD(X)) Q:X="" D
. S PSJORD=$P($G(PSJORD(X)),"^",1)
. D MEDRT(PSJORD)
. M PSJORD1(X)=^TMP("PSJMR",$J) K ^TMP("PSJMR",$J) ;Start with fresh TMP for each OI
D OVERLAP
I PSJQOF=1 S MCT=$O(MRTEMP2("A"),-1) D ALLMED(MCT)
M PSJORD1=^TMP("PSJMR",$J)
D REMDUP
K PSJORD
M PSJORD=PSJORD1
K PSJORD1,MRTEMP2,MRTEMP,MRNODE,MRNODE1,^TMP("PSJMR",$J),PSSCNTR1
Q
MEDRT(PSJORD) ;All Med Routes for dosage form.
N MR,X,PSJDFNO,MCT
S (MR,MCT,X,PSJDFNO)=0
S PSJDFNO=+$P($G(^PS(50.7,+PSJORD,0)),U,2)
S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P($G(^(0)),"^",4)=1 S ^TMP("PSJMR",$J,1)=MR_U_$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_$P(^(0),"^",2)_U_"D",MCT=MCT+1
S MR=0 F S MR=$O(^PS(50.606,PSJDFNO,"MR",MR)) Q:'MR D
. S X=+$G(^PS(50.606,PSJDFNO,"MR",MR,0))
. I X=$P($G(^PS(50.7,+PSJORD,0)),"^",6) Q ;Already counted as the default. Don't count twice.
. S MRNODE=$G(^PS(51.2,X,0))
. I $P($G(MRNODE),"^",4)'=1 Q
. S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=X_U_$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_$P(MRNODE,U,2)_U
Q
ALLMED(MCT) ;Return all med routes with IV flag set to 1
N MR,MRNODE
I MCT="" S MCT=0
S (MR,MRNODE)=""
F S MR=$O(^PS(51.2,MR)) Q:MR="" D
. S MRNODE=$G(^PS(51.2,MR,0))
. I $P(MRNODE,U,4)'=1 Q ;Not defined for all packages
. I $P(MRNODE,U,6)'=1 Q ;IV flag not set
. S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=MR_U_$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_$P(MRNODE,U,2)_U
Q
OVERLAP ; Only maintains any overlapping med routes between orderable items in order
N MR,MRNODE,X,PSSCNTR1
K MRTEMP,MRTEMP2
S (MR,MRNODE,X)=""
F S X=$O(PSJORD1(X)) Q:X="" D
. F S MR=$O(PSJORD1(X,MR)) Q:MR="" D
. . S MRNODE=$P($G(PSJORD1(X,MR)),"^",1)
. . S MRTEMP(MRNODE)=$G(MRTEMP(MRNODE))+1
S MR=""
F S MR=$O(MRTEMP(MR)) Q:MR="" D
. I MRTEMP(MR)'=$G(PSJORD(0)) K MRTEMP(MR) Q
I '$D(MRTEMP) K PSJORD1 S PSJORD1="" Q ;No overlapping med routes between orderable items.
S (MR,MRNODE)="",PSSCNTR1=1
F S MR=$O(MRTEMP(MR)) Q:MR="" D
. S MRNODE=$G(^PS(51.2,MR,0))
. S MRTEMP2(PSSCNTR1)=MR_U_$P(MRNODE,U,1)_U_$P(MRNODE,U,3)_U_$P(MRNODE,U,2)_U,PSSCNTR1=PSSCNTR1+1
K PSJORD1,MRTEMP
M PSJORD1=MRTEMP2
Q
REMDUP ; Remove duplicate entries
N MR,MRNODE
S MR="",MRNODE=""
F S MR=$O(PSJORD1(MR)) Q:MR="" D
. S MRNODE=$P($G(PSJORD1(MR)),"^",2)
. I $D(MRTEMP(MRNODE)) K PSJORD1(MR) Q
. S MRTEMP(MRNODE)=$G(PSJORD1(MR))
. I MR=1,$P($G(PSJORD1(MR)),"^",5)="D" S MRTEMP(MR)=PSJORD1(MR) Q ;Maintain default if there is one.
. S MRTEMP(MR)=PSJORD1(MR)
S MR=""
F S MR=$O(MRTEMP(MR)) Q:MR="" D
. I MR'?1.N K MRTEMP(MR)
I PSJORD(0)=1 M PSJORD1=MRTEMP
K MRTEMP
Q
PSSJORDF ;BIR/MV-RETURN MED ROUTES(MR) AND INSTRUCTIONS(INS) ;06/26/98
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**5,13,34,38,69,113,94,140**;9/30/97;Build 9
+2 ;;
+3 ; Reference to ^PS(50.7 is supported by DBIA 2180.
+4 ; Reference to ^PS(51.2 is supported by DBIA 2178.
+5 ; Reference to ^PS(50.606 is supported by DBIA 2174.
+6 ;
+7 ;* PSJORD is the Orderable Item IEN pass to Pharmacy by OE/RR.
+8 ;* 1. If the dosage form is valid, this routine will return all med
+9 ;* routes and instructions associated with that dose form.
+10 ;* 2. If the dose form is null, this routine will return all med routes
+11 ;* that exist in the medication routes file.
+12 ;* 3. ^TMP format:
+13 ;* ^TMP("PSJMR",$J,#)=MED ROUTE^MED ROUTE ABREVATION^IEN^OUTPATIENT
+14 ;* EXPANSION^IV FLAG^DEFAULT FLAG
+15 ;* ^TMP("PSJNOUN",$J,D0)=NOUN^VERB^PREPOSITION
+16 ;* ^TMP("PSJSCH",$J)=DEFAULT SCHEDULE NAME
+17 ;
START(PSJORD,PSJOPAC) ;
+1 NEW MR,MRNODE,INS,PSJDFNO,X,MCT,Z,PSJOISC
+2 IF '+PSJORD
DO MEDROUTE
QUIT
+3 SET PSJDFNO=+$PIECE($GET(^PS(50.7,+PSJORD,0)),U,2)
+4 SET PSJOISC=$PIECE($GET(^PS(50.7,+PSJORD,0)),"^",8)
+5 IF $GET(PSJOPAC)="O"!($GET(PSJOPAC)="X")
IF $GET(PSJOISC)'=""
DO EN^PSSOUTSC(.PSJOISC)
IF $GET(PSJOISC)'=""
SET ^TMP("PSJSCH",$JOB)=$GET(PSJOISC)
GOTO SCPASS
+6 IF $GET(PSJOISC)'=""
DO EN^PSSGSGUI(.PSJOISC,"I")
IF $GET(PSJOISC)'=""
SET ^TMP("PSJSCH",$JOB)=$GET(PSJOISC)
SCPASS ;
+1 IF $GET(^PS(50.606,PSJDFNO,0))=""
DO NOD
IF $DATA(^TMP("PSJMR",$JOB,1))
QUIT
DO MEDROUTE
QUIT
+2 KILL ^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB)
+3 DO DF
+4 QUIT
+5 ;
DF ;* Loop thru DF node to find all available med routes, nouns, and instructions.
+1 NEW VERB,MR,INS,X
+2 SET (MR,INS,X,MCT)=0
+3 SET VERB=$PIECE($GET(^PS(50.606,PSJDFNO,"MISC")),U)
+4 ;PSS*1*140 - If the orderable item has a default med route, send it back to CPRS
+5 ;as the only med route in ^TMP("PSJMR", otherwise use existing functionality.
+6 ;Check PHARMACY SYSTEM File (#59.7) to see if the site has set the
+7 ;parameter to use this functionality. 1 = yes, anything else = no
+8 SET MR=+$PIECE($GET(^PS(50.7,+PSJORD,0)),"^",6)
IF MR
IF $DATA(^PS(51.2,MR,0))
IF $PIECE($GET(^(0)),"^",4)=1
SET ^TMP("PSJMR",$JOB,1)=$PIECE(^PS(51.2,MR,0),"^")_U_$PIECE(^(0),"^",3)_U_MR_U_$PIECE(^(0),"^",2)_U_$SELECT($PIECE(^(0),"^",6):1,1:0)_"^D"
SET MCT=MCT+1
IF $PIECE($GET(^PS(59.7,1,80)),"^",7)=1
QUIT
+9 SET MR=0
FOR
SET MR=$ORDER(^PS(50.606,PSJDFNO,"MR",MR))
IF 'MR
QUIT
Begin DoDot:1
+10 SET X=+$GET(^PS(50.606,PSJDFNO,"MR",MR,0))
IF 'X!($PIECE($GET(^TMP("PSJMR",$JOB,1)),"^",3)=X)
QUIT
+11 SET MRNODE=$GET(^PS(51.2,X,0))
+12 IF $PIECE($GET(MRNODE),"^",4)'=1
QUIT
+13 SET MCT=MCT+1
SET ^TMP("PSJMR",$JOB,MCT)=$PIECE(MRNODE,U)_U_$PIECE(MRNODE,U,3)_U_X_U_$PIECE(MRNODE,U,2)_U_$SELECT($PIECE(MRNODE,U,6):1,1:0)
End DoDot:1
+14 SET X=0
+15 IF $DATA(^PS(50.606,PSJDFNO,"NOUN"))
FOR Z=0:0
SET Z=$ORDER(^PS(50.606,PSJDFNO,"NOUN",Z))
IF 'Z
QUIT
SET X=X+1
SET ^TMP("PSJNOUN",$JOB,X)=$PIECE($GET(^PS(50.606,PSJDFNO,"NOUN",Z,0)),U)_U_$PIECE($GET(^PS(50.606,PSJDFNO,"MISC")),U)_U_$PIECE($GET(^("MISC")),U,3)
+16 QUIT
+17 ;
MEDROUTE ;* Return all med routes in the med routes file.
+1 SET (MR,MCT)=0
KILL ^TMP("PSJMR",$JOB)
+2 FOR
SET MR=$ORDER(^PS(51.2,MR))
IF 'MR
QUIT
SET MRNODE=^PS(51.2,MR,0)
IF $PIECE(^PS(51.2,MR,0),"^",4)=1
SET MCT=MCT+1
SET ^TMP("PSJMR",$JOB,MCT)=$PIECE(MRNODE,U)_U_$PIECE(MRNODE,U,3)_U_MR_U_$PIECE(MRNODE,U,2)_U_$SELECT($PIECE(MRNODE,U,6):1,1:0)
+3 QUIT
NOD KILL ^TMP("PSJMR",$JOB)
+1 SET MR=+$PIECE($GET(^PS(50.7,+PSJORD,0)),"^",6)
IF MR
IF $DATA(^PS(51.2,MR,0))
IF $PIECE(^PS(51.2,MR,0),"^",4)=1
SET ^TMP("PSJMR",$JOB,1)=$PIECE(^PS(51.2,MR,0),"^")_U_$PIECE(^(0),"^",3)_U_MR_U_$PIECE(^(0),"^",2)_U_$SELECT($PIECE(^(0),"^",6):1,1:0)_"^D"
+2 QUIT
START1(PSJORD,PSJQOF) ;Entry point for IV dialog PSS*1*94
+1 ; This is the new entry point for the IV Dialog box from CPRS GUI 27. PSJORD will be an array
+2 ; sent by CPRS that contains all the IENS for all orderable items that are part of the order. The zero node of the array
+3 ; will contain the total number of orderable items in the order.
+4 ;
+5 ; PSJQOF is the quick order flag. 0=not a quick order 1=quick order
+6 ;
+7 ; If there is only one orderable item, any default defined in the Pharmacy Orderable Item file (50.7) will be
+8 ; marked with a D at the end of the data string.
+9 ;
+10 ; If there is more than one orderable item in the order, no default will be sent, and a union (the overlapping)
+11 ; of the med routes will be returned. For example if Dextrose can be given IV or IM, and the Ampicillin is only
+12 ; given IM, IM is the only med route that will be returned because it is the only overlapping med route between
+13 ; the two orderable items. If there is no overlapping med route to be returned, then a NULL will be returned to CPRS.
+14 ;
+15 ; If the quick order flag PSJQOF is set to 1, then CPRS is expecting the overlapping med routes for the orderable items
+16 ; as well as the entire list of med routes that are flagged for IV's.
+17 ;
+18 IF PSJQOF=""
SET PSJQOF=0
+19 KILL PSJORD1,^TMP("PSJMR",$JOB)
+20 IF $GET(PSJORD(0))=1
SET PSJOPAC="I"
Begin DoDot:1
+21 SET PSJORD=$PIECE($GET(PSJORD(1)),"^",1)
+22 DO MEDRT(PSJORD)
+23 IF PSJQOF=1
SET MCT=$ORDER(^TMP("PSJMR",$JOB,"A"),-1)
DO ALLMED(MCT)
+24 MERGE PSJORD1=^TMP("PSJMR",$JOB)
+25 DO REMDUP
+26 KILL PSJORD
+27 MERGE PSJORD=PSJORD1
+28 KILL PSJORD1,^TMP("PSJMR",$JOB)
End DoDot:1
QUIT
+29 SET X=0
+30 FOR
SET X=$ORDER(PSJORD(X))
IF X=""
QUIT
Begin DoDot:1
+31 SET PSJORD=$PIECE($GET(PSJORD(X)),"^",1)
+32 DO MEDRT(PSJORD)
+33 ;Start with fresh TMP for each OI
MERGE PSJORD1(X)=^TMP("PSJMR",$JOB)
KILL ^TMP("PSJMR",$JOB)
End DoDot:1
+34 DO OVERLAP
+35 IF PSJQOF=1
SET MCT=$ORDER(MRTEMP2("A"),-1)
DO ALLMED(MCT)
+36 MERGE PSJORD1=^TMP("PSJMR",$JOB)
+37 DO REMDUP
+38 KILL PSJORD
+39 MERGE PSJORD=PSJORD1
+40 KILL PSJORD1,MRTEMP2,MRTEMP,MRNODE,MRNODE1,^TMP("PSJMR",$JOB),PSSCNTR1
+41 QUIT
MEDRT(PSJORD) ;All Med Routes for dosage form.
+1 NEW MR,X,PSJDFNO,MCT
+2 SET (MR,MCT,X,PSJDFNO)=0
+3 SET PSJDFNO=+$PIECE($GET(^PS(50.7,+PSJORD,0)),U,2)
+4 SET MR=+$PIECE($GET(^PS(50.7,+PSJORD,0)),"^",6)
IF MR
IF $DATA(^PS(51.2,MR,0))
IF $PIECE($GET(^(0)),"^",4)=1
SET ^TMP("PSJMR",$JOB,1)=MR_U_$PIECE(^PS(51.2,MR,0),"^")_U_$PIECE(^(0),"^",3)_U_$PIECE(^(0),"^",2)_U_"D"
SET MCT=MCT+1
+5 SET MR=0
FOR
SET MR=$ORDER(^PS(50.606,PSJDFNO,"MR",MR))
IF 'MR
QUIT
Begin DoDot:1
+6 SET X=+$GET(^PS(50.606,PSJDFNO,"MR",MR,0))
+7 ;Already counted as the default. Don't count twice.
IF X=$PIECE($GET(^PS(50.7,+PSJORD,0)),"^",6)
QUIT
+8 SET MRNODE=$GET(^PS(51.2,X,0))
+9 IF $PIECE($GET(MRNODE),"^",4)'=1
QUIT
+10 SET MCT=MCT+1
SET ^TMP("PSJMR",$JOB,MCT)=X_U_$PIECE(MRNODE,U)_U_$PIECE(MRNODE,U,3)_U_$PIECE(MRNODE,U,2)_U
End DoDot:1
+11 QUIT
ALLMED(MCT) ;Return all med routes with IV flag set to 1
+1 NEW MR,MRNODE
+2 IF MCT=""
SET MCT=0
+3 SET (MR,MRNODE)=""
+4 FOR
SET MR=$ORDER(^PS(51.2,MR))
IF MR=""
QUIT
Begin DoDot:1
+5 SET MRNODE=$GET(^PS(51.2,MR,0))
+6 ;Not defined for all packages
IF $PIECE(MRNODE,U,4)'=1
QUIT
+7 ;IV flag not set
IF $PIECE(MRNODE,U,6)'=1
QUIT
+8 SET MCT=MCT+1
SET ^TMP("PSJMR",$JOB,MCT)=MR_U_$PIECE(MRNODE,U)_U_$PIECE(MRNODE,U,3)_U_$PIECE(MRNODE,U,2)_U
End DoDot:1
+9 QUIT
OVERLAP ; Only maintains any overlapping med routes between orderable items in order
+1 NEW MR,MRNODE,X,PSSCNTR1
+2 KILL MRTEMP,MRTEMP2
+3 SET (MR,MRNODE,X)=""
+4 FOR
SET X=$ORDER(PSJORD1(X))
IF X=""
QUIT
Begin DoDot:1
+5 FOR
SET MR=$ORDER(PSJORD1(X,MR))
IF MR=""
QUIT
Begin DoDot:2
+6 SET MRNODE=$PIECE($GET(PSJORD1(X,MR)),"^",1)
+7 SET MRTEMP(MRNODE)=$GET(MRTEMP(MRNODE))+1
End DoDot:2
End DoDot:1
+8 SET MR=""
+9 FOR
SET MR=$ORDER(MRTEMP(MR))
IF MR=""
QUIT
Begin DoDot:1
+10 IF MRTEMP(MR)'=$GET(PSJORD(0))
KILL MRTEMP(MR)
QUIT
End DoDot:1
+11 ;No overlapping med routes between orderable items.
IF '$DATA(MRTEMP)
KILL PSJORD1
SET PSJORD1=""
QUIT
+12 SET (MR,MRNODE)=""
SET PSSCNTR1=1
+13 FOR
SET MR=$ORDER(MRTEMP(MR))
IF MR=""
QUIT
Begin DoDot:1
+14 SET MRNODE=$GET(^PS(51.2,MR,0))
+15 SET MRTEMP2(PSSCNTR1)=MR_U_$PIECE(MRNODE,U,1)_U_$PIECE(MRNODE,U,3)_U_$PIECE(MRNODE,U,2)_U
SET PSSCNTR1=PSSCNTR1+1
End DoDot:1
+16 KILL PSJORD1,MRTEMP
+17 MERGE PSJORD1=MRTEMP2
+18 QUIT
REMDUP ; Remove duplicate entries
+1 NEW MR,MRNODE
+2 SET MR=""
SET MRNODE=""
+3 FOR
SET MR=$ORDER(PSJORD1(MR))
IF MR=""
QUIT
Begin DoDot:1
+4 SET MRNODE=$PIECE($GET(PSJORD1(MR)),"^",2)
+5 IF $DATA(MRTEMP(MRNODE))
KILL PSJORD1(MR)
QUIT
+6 SET MRTEMP(MRNODE)=$GET(PSJORD1(MR))
+7 ;Maintain default if there is one.
IF MR=1
IF $PIECE($GET(PSJORD1(MR)),"^",5)="D"
SET MRTEMP(MR)=PSJORD1(MR)
QUIT
+8 SET MRTEMP(MR)=PSJORD1(MR)
End DoDot:1
+9 SET MR=""
+10 FOR
SET MR=$ORDER(MRTEMP(MR))
IF MR=""
QUIT
Begin DoDot:1
+11 IF MR'?1.N
KILL MRTEMP(MR)
End DoDot:1
+12 IF PSJORD(0)=1
MERGE PSJORD1=MRTEMP
+13 KILL MRTEMP
+14 QUIT
