PSJORREN ;BIR/MV-RENEWAL FLAG ;6 DEC 00 / 3:11 PM
;;5.0;INPATIENT MEDICATIONS ;**50,70,58,89,91,110,127,134,309**;16 DEC 97;Build 3
;
; Reference to ^PS(50.7 supported by DBIA #2180
; References to ^PS(52.6 supported by DBIA #1231
; References to ^PS(52.7 supported by DBIA #2173
; References to ^PS(55 supported by DBIA #2191
; Reference to ^PSDRUG( is supported by DBIA 2192
;
ACTIVE(DFN,ON) ;
;DFN: Patient IEN
;ON : Order number_"U/V/P"
;Output: 0^reason not renewable (Can't renew)
; 2^New OI (Need to create a new order as in edit)
; note: with PSJ*5*70 - instead of 2, IV order will return 0
; 1 (OK to renew)
NEW PSJRT,PSJEXP
I '$D(^PS(53.1,+ON))&'$D(^PS(55,+DFN,5,+ON,0))&'$D(^PS(55,+DFN,"IV",+ON,0)) S PSJRT="0^Invalid Package Reference" Q $G(PSJRT)
D:ON["U" UD
D:ON["V" IV
;*309 - Changed error message
I (+$G(PSJRT)=1) S PSJEXP=$$EXPIRED^PSGOER(DFN,ON) I PSJEXP S PSJRT="0^Expired - Order Renewal Time Limit Exceeded. New order required to continue therapy."
Q $G(PSJRT)
UD ;
;If both PSJRT(2) & (3) existed it meant order has multiple DDs and one
;is tied to a different OI. It's best to not allow renewal of the order.
;
NEW PSJDD,PSJDDOI,PSJDDX,PSJACT,PSJOI,PSJOIACT,PSJUSE,PSJPRI,X,ND2
K PSJRT
S PSJOI=+^PS(55,DFN,5,+ON,.2)
S PSJPRI=$P(^PS(55,DFN,5,+ON,.2),"^",4)
I PSJPRI="D" S PSJRT="0^Orders with a Done priority may not be renewed" Q
S ND0=$G(^PS(55,DFN,5,+ON,0)) I $P(ND0,"^",7)="O" S PSJRT="0^One Time orders may not be renewed" Q
N PSJCANT,PSJDAD,NDP2,PSJORKID,PSJKID S NDP2=$G(^PS(55,DFN,5,+ON,.2)),PSJDAD=$P(NDP2,"^",8) I PSJDAD D
.S PSJORKID="" F S PSJORKID=$O(^PS(55,"ACX",PSJDAD,PSJORKID)) Q:'PSJORKID!$G(PSJCANT) S PSJKID="" F S PSJKID=$O(^PS(55,"ACX",PSJDAD,PSJORKID,PSJKID)) Q:'PSJKID!$G(PSJCANT) D
..S ND0=$G(^PS(55,DFN,5,+PSJKID,2)) I $P(ND0,"^",7)="O" S PSJRT="0^Complex Orders with One-Time doses may not be renewed",PSJCANT=1
Q:$G(PSJCANT)
F PSJDD=0:0 S PSJDD=$O(^PS(55,DFN,5,+ON,1,PSJDD)) Q:('PSJDD!$D(PSJRT(1))) D
. S (PSJACT,PSJOIACT)=0 S PSJDDX=^PS(55,DFN,5,+ON,1,PSJDD,0)
. S X=$P(PSJDDX,U,3) I X]"",(X'>DT) S PSJACT=1
. S X=$G(^PSDRUG(+PSJDDX,"I")) I X]"",(X'>DT) S PSJACT=1
. S X=$G(^PSDRUG(+PSJDDX,2)),PSJUSE=$P(X,U,3)["U",PSJDDOI=+X I '+PSJDDOI S PSJRT(3)="0^Dispense drug is not matched to an Orderable Item" Q
. S X=$P($G(^PS(50.7,+PSJDDOI,0)),U,4) I X]"",(X'>DT) S PSJOIACT=1
. I 'PSJACT,PSJUSE D Q
.. I PSJOI=PSJDDOI D Q
... I 'PSJOIACT S PSJRT(1)=1 Q
... S:PSJOIACT PSJRT(3)="0^Inactive Orderable Item"
.. I +PSJDDOI,(PSJOI'=PSJDDOI) D
... S:'PSJOIACT PSJRT(2)="2"_U_PSJDDOI
... S:PSJOIACT PSJRT(3)="0^Dispense drug ties to an inactive Orderable Item"
. I PSJACT S PSJRT(3)="0^This drug has been Inactivated"
. I 'PSJUSE S PSJRT(3)="0^Drug is No longer used in Inpatient Meds"
I $D(PSJRT(1)) S PSJRT=1 Q
I $D(PSJRT(2)),$D(PSJRT(3)) S PSJRT=PSJRT(3) Q
I '$D(PSJRT) S PSJRT="0^Order has no Dispense drug" Q
S X=$O(PSJRT(0)),PSJRT=$G(PSJRT(X))
Q
IV ;
NEW FIL,PSJACT,PSJAS,PSJASNO,PSJASOI,PSJCNT,PSJIEN,PSJOI,PSJOIACT,PSJPRI,X
K PSJRT
S PSJCNT=0
S PSJOI=+$G(^PS(55,DFN,"IV",+ON,.2))
S PSJPRI=$P(^PS(55,DFN,"IV",+ON,.2),"^",4)
I PSJPRI="D" S PSJRT="0^Orders with a Done priority may not be renewed" Q
N ND2,PSBACT,IVSCHED
S ND0=$G(^PS(55,DFN,"IV",+ON,0)) I ($P(ND0,"^",4)="P")!($P(ND0,"^",23)="P")!$P(ND0,"^",5) D Q:$G(PSJRT)]""
.N X,PSGOES,ZZND S PSGOES=2,X=$P(ND0,"^",9) D ENOS^PSGS0 Q:($G(X)="")!($P($G(ZZND),"^",5)'="O")
.S PSJRT="0^This One-Time order may not be renewed"
F FIL="AD","SOL" F PSJAS=0:0 S PSJAS=$O(^PS(55,DFN,"IV",+ON,FIL,PSJAS)) Q:'PSJAS D
. S (PSJACT,PSJOIACT)=0
. S PSJASNO=$S(FIL="AD":52.6,1:52.7)
. S PSJIEN=+^PS(55,DFN,"IV",+ON,FIL,PSJAS,0)
. S X=$G(^PS(PSJASNO,+PSJIEN,"I")) I X]"",(X'>DT) S PSJACT=1
. S PSJASOI=$P(^PS(PSJASNO,PSJIEN,0),U,11)
. S X=$P($G(^PS(50.7,+PSJASOI,0)),U,4) I X]"",(X'>DT) S PSJOIACT=1
. I PSJACT S PSJCNT=PSJCNT+1,PSJRT(3)="0^Inactive "_$S(FIL="AD":"Additive",1:"Solution") Q
. I PSJOI=PSJASOI D Q
.. I 'PSJOIACT S PSJRT(1)="" Q
.. I PSJOIACT S PSJRT(3)="0^Inactive Orderable Item"
. I PSJOI'=PSJASOI D
.. I 'PSJOIACT S PSJCNT=PSJCNT+1,PSJRT(2)=2_U_PSJASOI
.. I PSJOIACT S PSJRT(3)="0^Inactive Orderable Item"
I $D(PSJRT(1)) S PSJRT=1 Q
I $D(PSJRT(3)) S PSJRT=PSJRT(3) Q
I $D(PSJRT(2)),PSJCNT=1 S PSJRT="0^New Orderable Item" Q
S PSJRT="0^Inactive drug"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJORREN 4459 printed Dec 13, 2024@02:08:24 Page 2
PSJORREN ;BIR/MV-RENEWAL FLAG ;6 DEC 00 / 3:11 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**50,70,58,89,91,110,127,134,309**;16 DEC 97;Build 3
+2 ;
+3 ; Reference to ^PS(50.7 supported by DBIA #2180
+4 ; References to ^PS(52.6 supported by DBIA #1231
+5 ; References to ^PS(52.7 supported by DBIA #2173
+6 ; References to ^PS(55 supported by DBIA #2191
+7 ; Reference to ^PSDRUG( is supported by DBIA 2192
+8 ;
ACTIVE(DFN,ON) ;
+1 ;DFN: Patient IEN
+2 ;ON : Order number_"U/V/P"
+3 ;Output: 0^reason not renewable (Can't renew)
+4 ; 2^New OI (Need to create a new order as in edit)
+5 ; note: with PSJ*5*70 - instead of 2, IV order will return 0
+6 ; 1 (OK to renew)
+7 NEW PSJRT,PSJEXP
+8 IF '$DATA(^PS(53.1,+ON))&'$DATA(^PS(55,+DFN,5,+ON,0))&'$DATA(^PS(55,+DFN,"IV",+ON,0))
SET PSJRT="0^Invalid Package Reference"
QUIT $GET(PSJRT)
+9 if ON["U"
DO UD
+10 if ON["V"
DO IV
+11 ;*309 - Changed error message
+12 IF (+$GET(PSJRT)=1)
SET PSJEXP=$$EXPIRED^PSGOER(DFN,ON)
IF PSJEXP
SET PSJRT="0^Expired - Order Renewal Time Limit Exceeded. New order required to continue therapy."
+13 QUIT $GET(PSJRT)
UD ;
+1 ;If both PSJRT(2) & (3) existed it meant order has multiple DDs and one
+2 ;is tied to a different OI. It's best to not allow renewal of the order.
+3 ;
+4 NEW PSJDD,PSJDDOI,PSJDDX,PSJACT,PSJOI,PSJOIACT,PSJUSE,PSJPRI,X,ND2
+5 KILL PSJRT
+6 SET PSJOI=+^PS(55,DFN,5,+ON,.2)
+7 SET PSJPRI=$PIECE(^PS(55,DFN,5,+ON,.2),"^",4)
+8 IF PSJPRI="D"
SET PSJRT="0^Orders with a Done priority may not be renewed"
QUIT
+9 SET ND0=$GET(^PS(55,DFN,5,+ON,0))
IF $PIECE(ND0,"^",7)="O"
SET PSJRT="0^One Time orders may not be renewed"
QUIT
+10 NEW PSJCANT,PSJDAD,NDP2,PSJORKID,PSJKID
SET NDP2=$GET(^PS(55,DFN,5,+ON,.2))
SET PSJDAD=$PIECE(NDP2,"^",8)
IF PSJDAD
Begin DoDot:1
+11 SET PSJORKID=""
FOR
SET PSJORKID=$ORDER(^PS(55,"ACX",PSJDAD,PSJORKID))
if 'PSJORKID!$GET(PSJCANT)
QUIT
SET PSJKID=""
FOR
SET PSJKID=$ORDER(^PS(55,"ACX",PSJDAD,PSJORKID,PSJKID))
if 'PSJKID!$GET(PSJCANT)
QUIT
Begin DoDot:2
+12 SET ND0=$GET(^PS(55,DFN,5,+PSJKID,2))
IF $PIECE(ND0,"^",7)="O"
SET PSJRT="0^Complex Orders with One-Time doses may not be renewed"
SET PSJCANT=1
End DoDot:2
End DoDot:1
+13 if $GET(PSJCANT)
QUIT
+14 FOR PSJDD=0:0
SET PSJDD=$ORDER(^PS(55,DFN,5,+ON,1,PSJDD))
if ('PSJDD!$DATA(PSJRT(1)))
QUIT
Begin DoDot:1
+15 SET (PSJACT,PSJOIACT)=0
SET PSJDDX=^PS(55,DFN,5,+ON,1,PSJDD,0)
+16 SET X=$PIECE(PSJDDX,U,3)
IF X]""
IF (X'>DT)
SET PSJACT=1
+17 SET X=$GET(^PSDRUG(+PSJDDX,"I"))
IF X]""
IF (X'>DT)
SET PSJACT=1
+18 SET X=$GET(^PSDRUG(+PSJDDX,2))
SET PSJUSE=$PIECE(X,U,3)["U"
SET PSJDDOI=+X
IF '+PSJDDOI
SET PSJRT(3)="0^Dispense drug is not matched to an Orderable Item"
QUIT
+19 SET X=$PIECE($GET(^PS(50.7,+PSJDDOI,0)),U,4)
IF X]""
IF (X'>DT)
SET PSJOIACT=1
+20 IF 'PSJACT
IF PSJUSE
Begin DoDot:2
+21 IF PSJOI=PSJDDOI
Begin DoDot:3
+22 IF 'PSJOIACT
SET PSJRT(1)=1
QUIT
+23 if PSJOIACT
SET PSJRT(3)="0^Inactive Orderable Item"
End DoDot:3
QUIT
+24 IF +PSJDDOI
IF (PSJOI'=PSJDDOI)
Begin DoDot:3
+25 if 'PSJOIACT
SET PSJRT(2)="2"_U_PSJDDOI
+26 if PSJOIACT
SET PSJRT(3)="0^Dispense drug ties to an inactive Orderable Item"
End DoDot:3
End DoDot:2
QUIT
+27 IF PSJACT
SET PSJRT(3)="0^This drug has been Inactivated"
+28 IF 'PSJUSE
SET PSJRT(3)="0^Drug is No longer used in Inpatient Meds"
End DoDot:1
+29 IF $DATA(PSJRT(1))
SET PSJRT=1
QUIT
+30 IF $DATA(PSJRT(2))
IF $DATA(PSJRT(3))
SET PSJRT=PSJRT(3)
QUIT
+31 IF '$DATA(PSJRT)
SET PSJRT="0^Order has no Dispense drug"
QUIT
+32 SET X=$ORDER(PSJRT(0))
SET PSJRT=$GET(PSJRT(X))
+33 QUIT
IV ;
+1 NEW FIL,PSJACT,PSJAS,PSJASNO,PSJASOI,PSJCNT,PSJIEN,PSJOI,PSJOIACT,PSJPRI,X
+2 KILL PSJRT
+3 SET PSJCNT=0
+4 SET PSJOI=+$GET(^PS(55,DFN,"IV",+ON,.2))
+5 SET PSJPRI=$PIECE(^PS(55,DFN,"IV",+ON,.2),"^",4)
+6 IF PSJPRI="D"
SET PSJRT="0^Orders with a Done priority may not be renewed"
QUIT
+7 NEW ND2,PSBACT,IVSCHED
+8 SET ND0=$GET(^PS(55,DFN,"IV",+ON,0))
IF ($PIECE(ND0,"^",4)="P")!($PIECE(ND0,"^",23)="P")!$PIECE(ND0,"^",5)
Begin DoDot:1
+9 NEW X,PSGOES,ZZND
SET PSGOES=2
SET X=$PIECE(ND0,"^",9)
DO ENOS^PSGS0
if ($GET(X)="")!($PIECE($GET(ZZND),"^",5)'="O")
QUIT
+10 SET PSJRT="0^This One-Time order may not be renewed"
End DoDot:1
if $GET(PSJRT)]""
QUIT
+11 FOR FIL="AD","SOL"
FOR PSJAS=0:0
SET PSJAS=$ORDER(^PS(55,DFN,"IV",+ON,FIL,PSJAS))
if 'PSJAS
QUIT
Begin DoDot:1
+12 SET (PSJACT,PSJOIACT)=0
+13 SET PSJASNO=$SELECT(FIL="AD":52.6,1:52.7)
+14 SET PSJIEN=+^PS(55,DFN,"IV",+ON,FIL,PSJAS,0)
+15 SET X=$GET(^PS(PSJASNO,+PSJIEN,"I"))
IF X]""
IF (X'>DT)
SET PSJACT=1
+16 SET PSJASOI=$PIECE(^PS(PSJASNO,PSJIEN,0),U,11)
+17 SET X=$PIECE($GET(^PS(50.7,+PSJASOI,0)),U,4)
IF X]""
IF (X'>DT)
SET PSJOIACT=1
+18 IF PSJACT
SET PSJCNT=PSJCNT+1
SET PSJRT(3)="0^Inactive "_$SELECT(FIL="AD":"Additive",1:"Solution")
QUIT
+19 IF PSJOI=PSJASOI
Begin DoDot:2
+20 IF 'PSJOIACT
SET PSJRT(1)=""
QUIT
+21 IF PSJOIACT
SET PSJRT(3)="0^Inactive Orderable Item"
End DoDot:2
QUIT
+22 IF PSJOI'=PSJASOI
Begin DoDot:2
+23 IF 'PSJOIACT
SET PSJCNT=PSJCNT+1
SET PSJRT(2)=2_U_PSJASOI
+24 IF PSJOIACT
SET PSJRT(3)="0^Inactive Orderable Item"
End DoDot:2
End DoDot:1
+25 IF $DATA(PSJRT(1))
SET PSJRT=1
QUIT
+26 IF $DATA(PSJRT(3))
SET PSJRT=PSJRT(3)
QUIT
+27 IF $DATA(PSJRT(2))
IF PSJCNT=1
SET PSJRT="0^New Orderable Item"
QUIT
+28 SET PSJRT="0^Inactive drug"
+29 QUIT
