- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJORREN.m
r613 r623 1 PSJORREN 2 ;;5.0; INPATIENT MEDICATIONS ;**50,70,58,89,91,110,127,134**;16 DEC 97;Build 124 3 4 5 6 7 8 9 10 ACTIVE(DFN,ON) 11 12 13 14 15 16 17 18 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) 19 D:ON["U" UD 20 D:ON["V" IV 21 I (+$G(PSJRT)=1) S PSJEXP=$$EXPIRED^PSGOER(DFN,ON) I PSJEXP S PSJRT="0^Expired Time Limit Exceeded" 22 Q $G(PSJRT) 23 UD ; 24 ;If both PSJRT(2) & (3) existed it meant order has multiple DDs and one 25 ;is tied to a different OI. It's best to not allow renewal of the order. 26 ; 27 NEW PSJDD,PSJDDOI,PSJDDX,PSJACT,PSJOI,PSJOIACT,PSJUSE,PSJPRI,X,ND2 28 K PSJRT 29 S PSJOI=+^PS(55,DFN,5,+ON,.2)30 S PSJPRI=$P(^PS(55,DFN,5,+ON,.2),"^",4) 31 I PSJPRI="D" S PSJRT="0^Orders with a Done prioritymay not be renewed" Q32 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 33 N PSJCANT,PSJDAD,NDP2,PSJORKID,PSJKID S NDP2=$G(^PS(55,DFN,5,+ON,.2)),PSJDAD=$P(NDP2,"^",8) I PSJDADD34 .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 35 ..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 36 Q:$G(PSJCANT) 37 F PSJDD=0:0 S PSJDD=$O(^PS(55,DFN,5,+ON,1,PSJDD)) Q:('PSJDD!$D(PSJRT(1))) D 38 . S (PSJACT,PSJOIACT)=0 S PSJDDX=^PS(55,DFN,5,+ON,1,PSJDD,0) 39 . S X=$P(PSJDDX,U,3) I X]"",(X'>DT) S PSJACT=140 . S X=$G(^PSDRUG(+PSJDDX,"I")) I X]"",(X'>DT) S PSJACT=1 41 . 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 42 . S X=$P($G(^PS(50.7,+PSJDDOI,0)),U,4) I X]"",(X'>DT) S PSJOIACT=1 43 . I 'PSJACT,PSJUSED Q44 .. I PSJOI=PSJDDOI DQ45 ... I 'PSJOIACT S PSJRT(1)=1 Q 46 ... S:PSJOIACT PSJRT(3)="0^Inactive Orderable Item" 47 .. I +PSJDDOI,(PSJOI'=PSJDDOI) D 48 ... S:'PSJOIACT PSJRT(2)="2"_U_PSJDDOI 49 ... S:PSJOIACT PSJRT(3)="0^Dispense drug ties to an inactive Orderable Item"50 . I PSJACT S PSJRT(3)="0^This drug has been Inactivated"51 . I 'PSJUSE S PSJRT(3)="0^Drug is No longer used in Inpatient Meds" 52 I $D(PSJRT(1)) S PSJRT=1Q53 I $D(PSJRT(2)),$D(PSJRT(3)) S PSJRT=PSJRT(3)Q54 I '$D(PSJRT) S PSJRT="0^Order has no Dispense drug" Q 55 S X=$O(PSJRT(0)),PSJRT=$G(PSJRT(X)) 56 Q 57 IV ; 58 NEW FIL,PSJACT,PSJAS,PSJASNO,PSJASOI,PSJCNT,PSJIEN,PSJOI,PSJOIACT,PSJPRI,X 59 K PSJRT 60 S PSJCNT=0 61 S PSJOI=+$G(^PS(55,DFN,"IV",+ON,.2))62 S PSJPRI=$P(^PS(55,DFN,"IV",+ON,.2),"^",4) 63 I PSJPRI="D" S PSJRT="0^Orders with a Done priority may not be renewed" Q 64 N ND2,PSBACT,IVSCHED 65 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)]"" 66 .N X,PSGOES,ZZND S PSGOES=2,X=$P(ND0,"^",9) D ENOS^PSGS0 Q:($G(X)="")!($P($G(ZZND),"^",5)'="O") 67 .S PSJRT="0^This One-Time order may not be renewed" 68 F FIL="AD","SOL" F PSJAS=0:0 S PSJAS=$O(^PS(55,DFN,"IV",+ON,FIL,PSJAS)) Q:'PSJAS D 69 . S (PSJACT,PSJOIACT)=0 70 . S PSJASNO=$S(FIL="AD":52.6,1:52.7)71 . S PSJIEN=+^PS(55,DFN,"IV",+ON,FIL,PSJAS,0) 72 . S X=$G(^PS(PSJASNO,+PSJIEN,"I")) I X]"",(X'>DT) S PSJACT=1 73 . S PSJASOI=$P(^PS(PSJASNO,PSJIEN,0),U,11) 74 . S X=$P($G(^PS(50.7,+PSJASOI,0)),U,4) I X]"",(X'>DT) S PSJOIACT=1 75 . I PSJACT S PSJCNT=PSJCNT+1,PSJRT(3)="0^Inactive "_$S(FIL="AD":"Additive",1:"Solution")Q76 . I PSJOI=PSJASOI DQ77 .. I 'PSJOIACT S PSJRT(1)="" Q 78 .. I PSJOIACT S PSJRT(3)="0^Inactive Orderable Item" 79 . I PSJOI'=PSJASOI D 80 .. I 'PSJOIACT S PSJCNT=PSJCNT+1,PSJRT(2)=2_U_PSJASOI 81 .. I PSJOIACT S PSJRT(3)="0^Inactive Orderable Item" 82 I $D(PSJRT(1)) S PSJRT=1Q83 I $D(PSJRT(3)) S PSJRT=PSJRT(3) Q84 85 86 1 PSJORREN ;BIR/MV-RENEWAL FLAG ;6 DEC 00 / 3:11 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**50,70,58,89,91,110,127**;16 DEC 97 3 ; 4 ; Reference to ^PS(50.7 supported by DBIA #2180 5 ; References to ^PS(52.6 supported by DBIA #1231 6 ; References to ^PS(52.7 supported by DBIA #2173 7 ; References to ^PS(55 supported by DBIA #2191 8 ; Reference to ^PSDRUG( is supported by DBIA 2192 9 ; 10 ACTIVE(DFN,ON) ; 11 ;DFN: Patient IEN 12 ;ON : Order number_"U/V/P" 13 ;Output: 0^reason not renewable (Can't renew) 14 ; 2^New OI (Need to create a new order as in edit) 15 ; note: with PSJ*5*70 - instead of 2, IV order will return 0 16 ; 1 (OK to renew) 17 NEW PSJRT,PSJEXP 18 D:ON["U" UD 19 D:ON["V" IV 20 I (+$G(PSJRT)=1) S PSJEXP=$$EXPIRED^PSGOER(DFN,ON) I PSJEXP S PSJRT="0^Expired Time Limit Exceeded" 21 Q $G(PSJRT) 22 UD ; 23 ;If both PSJRT(2) & (3) existed it meant order has multiple DDs and one 24 ;is tied to a different OI. It's best to not allow renewal of the order. 25 ; 26 NEW PSJDD,PSJDDOI,PSJDDX,PSJACT,PSJOI,PSJOIACT,PSJUSE,PSJPRI,X,ND2 27 K PSJRT 28 S PSJOI=+^PS(55,DFN,5,+ON,.2) 29 S PSJPRI=$P(^PS(55,DFN,5,+ON,.2),"^",4) 30 I PSJPRI="D" S PSJRT="0^Orders with a Done priority may not be renewed" Q 31 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 32 N PSJCANT,PSJDAD,NDP2,PSJORKID,PSJKID S NDP2=$G(^PS(55,DFN,5,+ON,.2)),PSJDAD=$P(NDP2,"^",8) I PSJDAD D 33 .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 34 ..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 35 Q:$G(PSJCANT) 36 F PSJDD=0:0 S PSJDD=$O(^PS(55,DFN,5,+ON,1,PSJDD)) Q:('PSJDD!$D(PSJRT(1))) D 37 . S (PSJACT,PSJOIACT)=0 S PSJDDX=^PS(55,DFN,5,+ON,1,PSJDD,0) 38 . S X=$P(PSJDDX,U,3) I X]"",(X'>DT) S PSJACT=1 39 . S X=$G(^PSDRUG(+PSJDDX,"I")) I X]"",(X'>DT) S PSJACT=1 40 . 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 41 . S X=$P($G(^PS(50.7,+PSJDDOI,0)),U,4) I X]"",(X'>DT) S PSJOIACT=1 42 . I 'PSJACT,PSJUSE D Q 43 .. I PSJOI=PSJDDOI D Q 44 ... I 'PSJOIACT S PSJRT(1)=1 Q 45 ... S:PSJOIACT PSJRT(3)="0^Inactive Orderable Item" 46 .. I +PSJDDOI,(PSJOI'=PSJDDOI) D 47 ... S:'PSJOIACT PSJRT(2)="2"_U_PSJDDOI 48 ... S:PSJOIACT PSJRT(3)="0^Dispense drug ties to an inactive Orderable Item" 49 . I PSJACT S PSJRT(3)="0^This drug has been Inactivated" 50 . I 'PSJUSE S PSJRT(3)="0^Drug is No longer used in Inpatient Meds" 51 I $D(PSJRT(1)) S PSJRT=1 Q 52 I $D(PSJRT(2)),$D(PSJRT(3)) S PSJRT=PSJRT(3) Q 53 I '$D(PSJRT) S PSJRT="0^Order has no Dispense drug" Q 54 S X=$O(PSJRT(0)),PSJRT=$G(PSJRT(X)) 55 Q 56 IV ; 57 NEW FIL,PSJACT,PSJAS,PSJASNO,PSJASOI,PSJCNT,PSJIEN,PSJOI,PSJOIACT,PSJPRI,X 58 K PSJRT 59 S PSJCNT=0 60 S PSJOI=+$G(^PS(55,DFN,"IV",+ON,.2)) 61 S PSJPRI=$P(^PS(55,DFN,"IV",+ON,.2),"^",4) 62 I PSJPRI="D" S PSJRT="0^Orders with a Done priority may not be renewed" Q 63 N ND2,PSBACT,IVSCHED 64 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)]"" 65 .N X,PSGOES,ZZND S PSGOES=2,X=$P(ND0,"^",9) D ENOS^PSGS0 Q:($G(X)="")!($P($G(ZZND),"^",5)'="O") 66 .S PSJRT="0^This One-Time order may not be renewed" 67 F FIL="AD","SOL" F PSJAS=0:0 S PSJAS=$O(^PS(55,DFN,"IV",+ON,FIL,PSJAS)) Q:'PSJAS D 68 . S (PSJACT,PSJOIACT)=0 69 . S PSJASNO=$S(FIL="AD":52.6,1:52.7) 70 . S PSJIEN=+^PS(55,DFN,"IV",+ON,FIL,PSJAS,0) 71 . S X=$G(^PS(PSJASNO,+PSJIEN,"I")) I X]"",(X'>DT) S PSJACT=1 72 . S PSJASOI=$P(^PS(PSJASNO,PSJIEN,0),U,11) 73 . S X=$P($G(^PS(50.7,+PSJASOI,0)),U,4) I X]"",(X'>DT) S PSJOIACT=1 74 . I PSJACT S PSJCNT=PSJCNT+1,PSJRT(3)="0^Inactive "_$S(FIL="AD":"Additive",1:"Solution") Q 75 . I PSJOI=PSJASOI D Q 76 .. I 'PSJOIACT S PSJRT(1)="" Q 77 .. I PSJOIACT S PSJRT(3)="0^Inactive Orderable Item" 78 . I PSJOI'=PSJASOI D 79 .. I 'PSJOIACT S PSJCNT=PSJCNT+1,PSJRT(2)=2_U_PSJASOI 80 .. I PSJOIACT S PSJRT(3)="0^Inactive Orderable Item" 81 I $D(PSJRT(1)) S PSJRT=1 Q 82 I $D(PSJRT(3)) S PSJRT=PSJRT(3) Q 83 ;I $D(PSJRT(2)),PSJCNT=1 S PSJRT=PSJRT(2) Q 84 I $D(PSJRT(2)),PSJCNT=1 S PSJRT="0^New Orderable Item" Q 85 S PSJRT="0^Inactive drug" 86 Q
Note:
See TracChangeset
for help on using the changeset viewer.
