- 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 Feb 18, 2025@23:34:47 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