- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREVNTX.m
r613 r623 1 OREVNTX ; SLC/MKB - Event delayed orders RPC's ; 5/4/07 11:34am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,243**;Dec 17, 1997;Build 242 3 ; 4 PAT(ORY,DFN) ; -- Returns currently delayed events for patient DFN 5 N EVT,CNT,X,Y S DFN=+$G(DFN),(EVT,CNT)=0 6 F S EVT=+$O(^ORE(100.2,"AE",DFN,EVT)) Q:EVT<1 S Y=+$O(^(EVT,0)) D 7 . I $G(^ORE(100.2,Y,1)) K ^ORE(100.2,"AE",DFN,EVT,Y) Q 8 . Q:$$LAPSED(Y) ;I $$EMPTY(Y) D CANCEL(Y) Q 9 . Q:$O(^ORE(100.2,"DAD",Y,0)) ;has children 10 . S X=$P($G(^ORD(100.5,EVT,0)),U,8),X="Delayed "_$$LOWER^VALM1(X) 11 . S CNT=CNT+1,ORY(CNT)=Y_U_X 12 S:CNT ORY(0)=CNT 13 Q 14 ; 15 EXISTS(DFN,EVT) ; -- Returns 1 if patient DFN has delayed orders for EVT, 16 ; or 2 if parent/sibling event has delayed orders, else 0 17 ; 18 N X,Y,I S Y=0 I '$G(DFN)!'$G(EVT) G EXQ 19 I $O(^ORE(100.2,"AE",+DFN,+EVT,0)) S Y=1 G EXQ 20 S X=+$P($G(^ORD(100.5,+EVT,0)),U,12) I X D G EXQ ;ck parent,siblings 21 . I $O(^ORE(100.2,"AE",+DFN,X,0)) S Y=2 Q 22 . S I=0 F S I=+$O(^ORD(100.5,"DAD",X,I)) Q:I<1 I $O(^ORE(100.2,"AE",+DFN,I,0)) S Y=2 Q 23 EXQ Q Y 24 ; 25 LIST(ORY,DFN) ; -- Returns all processed events for patient DFN as 26 ; ORY(#) = PatEvtIEN ^ Display Text ^ EvtDateTime 27 ; in reverse chronological order 28 N IDT,DA,CNT,X0,X1,EVT,DC,X 29 S DFN=+$G(DFN),(IDT,CNT)=0 30 F S IDT=$O(^ORE(100.2,"AC",DFN,IDT)) Q:IDT<1 D 31 . S DA=0 F S DA=+$O(^ORE(100.2,"AC",DFN,IDT,DA)) Q:DA<1 D 32 .. S X0=$G(^ORE(100.2,DA,0)),X1=$G(^(1)) Q:$P(X1,U,5) ;has parent 33 .. S EVT=+$P(X0,U,2),DC=+$P(X1,U,3) 34 .. I '$P(X0,U,4),'$O(^ORE(100.2,DA,2,0)),'$O(^ORE(100.2,DA,3,0)),'$D(^OR(100,"AEVNT",DFN_";DPT(",DA)) Q ;no orders 35 .. S I=+$O(^ORE(100.2,DA,10,"B"),-1),X=$P($G(^(I,0)),U,2) I X="LP"!(X="CA") Q ;lapsed or cancelled 36 .. ;Q if not current admission? 37 .. S X=$S(EVT:$P($G(^ORD(100.5,EVT,0)),U,8),DC:$P($G(^ORD(100.6,DC,0)),U,5),1:"UNSPECIFIED EVENT") 38 .. S X=$$LOWER^VALM1(X),CNT=CNT+1,ORY(CNT)=DA_U_X_U_$P(X1,U) 39 S:CNT ORY(0)=CNT 40 Q 41 ; 42 COMP(PTEVT) ; -- Returns 1 or 0, if PTEVT has been completed 43 N Y,I S Y=$S($G(^ORE(100.2,+$G(PTEVT),1)):1,1:0) 44 I Y S I=+$O(^ORE(100.2,+$G(PTEVT),10,0)) S:$P($G(^(I,0)),U,2)="CA" Y=0 45 Q Y 46 ; 47 ACTIVE(ORY,TYPE) ; -- Returns all active events [of TYPE] from #100.5 48 ; where TYPE=string containing any of the codes from the TYPE field 49 N NM,IEN,CNT,X0,X S CNT=0,TYPE=$G(TYPE) 50 S NM="" F S NM=$O(^ORD(100.5,"C",NM)) Q:NM="" D 51 . S IEN=0 F S IEN=+$O(^ORD(100.5,"C",NM,IEN)) Q:IEN<1 D 52 .. S X0=$G(^ORD(100.5,IEN,0)) I '$L($P(X0,U,2)) D ;Child event 53 ... S X=$P(X0,U,12) S:X $P(X0,U,2)=$P($G(^ORD(100.5,+X,0)),U,2) 54 .. I $L(TYPE),TYPE'[$P(X0,U,2) Q 55 .. Q:$O(^ORD(100.5,"DAD",IEN,0)) ;Parent event 56 .. S CNT=CNT+1,ORY(CNT)=IEN_U_X0 57 S:CNT ORY(0)=CNT 58 Q 59 ; 60 NAME(PTEVT) ; -- Return name of Patient Event 61 N X,Y,Z S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2),Z=$G(^(1)) 62 S:X Y=$P($G(^ORD(100.5,X,0)),U,8) 63 I 'X S X=+$P(Z,U,3),Y=$P($G(^ORD(100.6,X,0)),U,5) 64 S Y=$S('Z:"Delayed ",1:"")_$$LOWER^VALM1(Y) 65 Q Y 66 ; 67 SHORTNM(PTEVT) ; -- Return Short Name of Patient Event 68 ; or first 15 characters of Event Name if unspecified 69 N X,Y,Y0 S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) I X D 70 . S Y0=$G(^ORD(100.5,X,0)),Y=$P(Y0,U,10) 71 . S:'$L(Y) Y=$E($P(Y0,U,8),1,15) 72 I 'X S X=+$P($G(^ORE(100.2,+$G(PTEVT),1)),U,3),Y=$E($P($G(^ORD(100.6,X,0)),U,5),1,15) 73 Q Y 74 ; 75 EVT(PTEVT) ; -- Return Event ptr #100.5, given PTEVT ptr #100.2 76 Q +$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 77 ; 78 DC(PTEVT) ; -- Return DC Rule ptr #100.6, given PTEVT ptr #100.2 79 I $P($G(^ORE(100.2,+$G(PTEVT),1)),U,5) S PTEVT=$P(^(1),U,5) ;use parent 80 Q +$P($G(^ORE(100.2,+$G(PTEVT),1)),U,3) 81 ; 82 TYPE(PTEVT) ; -- Return Type of Patient Event (i.e. A/D/T) 83 N X,Y S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 84 I $P($G(^ORD(100.5,X,0)),U,12) S X=$P(^(0),U,12) ;use parent 85 S Y=$S(X:$P($G(^ORD(100.5,X,0)),U,2),1:"DC") 86 Q Y 87 ; 88 DIV(PTEVT) ; -- Return Division for PTEVT 89 N X,Y S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 90 I $P($G(^ORD(100.5,X,0)),U,12) S X=$P(^(0),U,12) ;use parent 91 S Y=+$P($G(^ORD(100.5,X,0)),U,3) S:Y<1 Y=+$G(DUZ(2)) 92 Q Y 93 ; 94 LOC(PTEVT) ; -- Return Default Ordering Location for PTEVT 95 N X,X0,Y S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 96 S X0=$G(^ORD(100.5,X,0)),Y=+$P(X0,U,9)_";SC(" 97 I Y<1,$P(X0,U,12) S Y=+$P($G(^ORD(100.5,+$P(X0,U,12),0)),U,9)_";SC(" 98 S:Y<1 Y=$G(ORL) 99 Q Y 100 ; 101 EMPTY(PTEVT) ; -- Returns 1 or 0, if PTEVT has delayed orders 102 N Y,OR0,PAT,TYPE,PSO,IFN,STS S Y=1 I '$G(PTEVT) Q Y 103 S OR0=$G(^ORE(100.2,+PTEVT,0)),PAT=+$P(OR0,U)_";DPT(" 104 S TYPE=$$TYPE(PTEVT) I TYPE="D" S PSO=+$O(^DIC(9.4,"C","PSO",0)) 105 S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,PTEVT,IFN)) Q:IFN<1 D Q:'Y 106 . S STS=$P($G(^OR(100,IFN,3)),U,3) I STS=10 S Y=0 Q 107 . ;I IFN=+$P(OR0,U,4),STS=11!(STS=6) S Y=0 Q 108 . I TYPE="D",$P($G(^OR(100,IFN,0)),U,14)=PSO,STS=5!(STS=6) S Y=0 Q 109 I Y,$D(^ORE(100.2,"DAD",PTEVT)) D ;ck child events 110 . N CHLD S CHLD=0 111 . F S CHLD=+$O(^ORE(100.2,"DAD",PTEVT,CHLD)) Q:CHLD<1 D Q:'Y 112 .. S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,CHLD,IFN)) Q:IFN<1 I $P($G(^OR(100,IFN,3)),U,3)=10 S Y=0 Q 113 Q Y 114 ; 115 EVTORDER(ORDER) ; -- Returns 1 or 0, if ORDER is for event 116 ; Will return 0 if action DA is included but not NW 117 N X0,X,Y S X0=$G(^OR(100,+ORDER,0)),X=+$P(ORDER,";",2),Y=0 118 I $P(X0,U,17),X'>1 D 119 . I $P($G(^ORE(100.2,+$P(X0,U,17),0)),U,4)=+ORDER S Y=1 Q 120 . S DAD=+$P($G(^ORE(100.2,+$P(X0,U,17),1)),U,5) ;has parent? 121 . I DAD,$P($G(^ORE(100.2,DAD,0)),U,4)=+ORDER S Y=1 122 Q Y 123 ; 124 MANREL(ORDER) ; -- Returns 1 or 0, if ORDER was manually released 125 N EVT,Y,RELDT,TYPE,EVTDT S Y=0 126 S EVT=+$P($G(^OR(100,+ORDER,0)),U,17),RELDT=+$P($G(^(8,1,0)),U,16) 127 G:EVT<1 MNQ G:RELDT<1 MNQ ;not delayed or released 128 I '$D(^ORE(100.2,EVT,2,+ORDER)) S Y=1 G MNQ ;not rel'd by event 129 S TYPE=$$TYPE(EVT),EVTDT=+$G(^ORE(100.2,EVT,1)) 130 I TYPE="M",$$FMDIFF^XLFDT(EVTDT,RELDT,2)<300 S Y=1 131 MNQ Q Y 132 ; 133 CANCEL(PTEVT) ; -- Cancel empty PTEVT, event order 134 S PTEVT=+$G(PTEVT) D DONE(PTEVT),ACTLOG(PTEVT,"CA") 135 N IFN,DAD S IFN=+$P($G(^ORE(100.2,PTEVT,0)),U,4) 136 I IFN<1 D ;ck for parent w/event order 137 . S DAD=+$P($G(^ORE(100.2,PTEVT,1)),U,5) Q:DAD<1 138 . Q:'$G(^ORE(100.2,DAD,1)) ;parent still active 139 . S IFN=+$P($G(^ORE(100.2,DAD,0)),U,4) 140 I IFN D:'$$DCD^ORCACT2(IFN) CLRDLY^ORCACT2(IFN) ;cancel event order 141 Q 142 ; 143 DONE(PTEVT,WHEN,MVT,OR) ; -- Terminate PTEVT 144 Q:'$G(PTEVT) Q:'$D(^ORE(100.2,PTEVT,0)) 145 N X0,X1,PAT,EVT,DAD 146 S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) D D1 147 S DAD=$P(X1,U,5) I DAD,$$ALLDONE(DAD) S PTEVT=DAD D D1 Q 148 S DAD=PTEVT,PTEVT=0 ;if PTEVT=parent, terminate children too 149 F S PTEVT=+$O(^ORE(100.2,"DAD",DAD,PTEVT)) Q:PTEVT<1 D D1 150 Q 151 D1 S X0=$G(^ORE(100.2,+PTEVT,0)),X1=$G(^(1)) Q:'$L(X0) 152 S PAT=+$P(X0,U),EVT=+$P(X0,U,2) ;,ORD=+$P(X0,U,4) 153 S $P(X1,U,1,2)=WHEN_U_$G(MVT),$P(X1,U,4)=$G(OR),^ORE(100.2,PTEVT,1)=X1 154 S ^ORE(100.2,"AC",PAT,9999999-WHEN,PTEVT)="" 155 S:$G(OR) ^ORE(100.2,"ASR",OR,PTEVT)="" 156 K:EVT ^ORE(100.2,"AE",PAT,EVT,PTEVT) 157 Q 158 ; 159 ALLDONE(DAD) ; -- Returns 1 or 0, if all child events are done 160 N I,Y S Y=1,I=0 161 F S I=+$O(^ORE(100.2,"DAD",+$G(DAD),I)) Q:I<1 I '$G(^ORE(100.2,I,1)) S Y=0 Q 162 Q Y 163 ; 164 CHGEVT(IFN,NEWEVT) ; -- Change the Patient Event for order IFN to NEWEVT 165 ; Includes adding or removing event pointer to order 166 Q:'$G(IFN) N PAT,OLDEVT,OR3 S:$G(NEWEVT) NEWEVT=+NEWEVT 167 S PAT=$P($G(^OR(100,+IFN,0)),U,2),OLDEVT=$P($G(^(0)),U,17),OR3=$G(^(3)) 168 Q:OLDEVT=NEWEVT K:OLDEVT ^OR(100,"AEVNT",PAT,OLDEVT,+IFN) 169 S $P(^OR(100,+IFN,0),U,17)=NEWEVT S:NEWEVT ^OR(100,"AEVNT",PAT,NEWEVT,+IFN)="" 170 I NEWEVT,$P(OR3,U,3)'=10 S $P(^OR(100,+IFN,3),U,3)=10,$P(^(8,1,0),U,15)=10 171 I 'NEWEVT,$P(OR3,U,3)=10 S $P(^OR(100,+IFN,3),U,3)=11,$P(^(8,1,0),U,15)=11 D SET^ORDD100(+IFN,1) 172 Q 173 ; 174 ACTLOG(PTEVT,ACTION,EVTYPE,SAVE) ; -- Log a note for ACTION on PTEVT 175 ; SAVE => new data in VAIP() will be saved 176 Q:'$G(PTEVT) Q:'$D(^ORE(100.2,PTEVT,0)) Q:'$L($G(ACTION)) 177 N I,HDR,LAST,TOTAL,DA,ORNOW,MVT 178 F I=1:1:10 L +^ORE(100.2,PTEVT,10,0):1 Q:$T H 2 179 Q:'$T "^" S HDR=$G(^ORE(100.2,PTEVT,10,0)) S:'$L(HDR) HDR="^100.25DA^^" 180 S TOTAL=+$P(HDR,U,4),LAST=+$O(^ORE(100.2,PTEVT,10,"B"),-1) 181 S I=LAST F I=(I+1):1 Q:'$D(^ORE(100.2,PTEVT,10,I,0)) 182 S DA=I,$P(HDR,U,3,4)=DA_U_(TOTAL+1) 183 S ^ORE(100.2,PTEVT,10,0)=HDR L -^ORE(100.2,PTEVT,10,0) 184 S ORNOW=+$$NOW^XLFDT,^ORE(100.2,PTEVT,10,"B",ORNOW,DA)="" 185 S ^ORE(100.2,PTEVT,10,DA,0)=ORNOW_U_ACTION_U_$S(ACTION="LP":"",1:$G(DUZ))_U_$G(EVTYPE) 186 S MVT=+$P($G(^ORE(100.2,PTEVT,1)),U,2) 187 S:MVT ^ORE(100.2,"ADT",MVT,ORNOW,PTEVT,DA)="" 188 I $G(SAVE),$G(VAIP(4)) S $P(^ORE(100.2,PTEVT,10,DA,0),U,5,7)=+VAIP(4)_U_+VAIP(8)_U_+VAIP(5) 189 Q 190 ; 191 LAPSED(PTEVT) ; -- Ck if PTEVT has lapsed, if so lapse all orders 192 N Y,X0,EVT,ENTERED,DAYS S Y=0 193 I $G(^ORE(100.2,PTEVT,1)) G LPQ ;already terminated 194 S X0=$G(^ORE(100.2,PTEVT,0)),EVT=+$P(X0,U,2),ENTERED=+$P(X0,U,5) 195 S:$P($G(^ORD(100.5,EVT,0)),U,12) EVT=+$P(^(0),U,12) ;parent 196 S DAYS=+$P($G(^ORD(100.5,EVT,0)),U,6) I DAYS<1 G LPQ ;doesn't lapse 197 I ENTERED>$$FMADD^XLFDT(DT,(0-DAYS)) G LPQ ;not lapsed yet 198 D LP1(PTEVT) S Y=1 ;lapse orders, event 199 N J S J=0 F S J=$O(^ORE(100.2,"DAD",PTEVT,J)) Q:'J D LP1(J) 200 LPQ Q Y 201 ; 202 LP1(PTEVT) ; -- Lapse orders, event PTEVT 203 N X0,PAT,IFN,STS 204 S X0=$G(^ORE(100.2,PTEVT,0)),PAT=+$P(X0,U)_";DPT(" 205 S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,PTEVT,IFN)) Q:IFN<1 D 206 . S STS=$P($G(^OR(100,IFN,3)),U,3) I (STS=10)!(STS=11)!(IFN=+$P(X0,U,4)) D 207 .. D STATUS^ORCSAVE2(IFN,14) 208 .. D ALPS^ORCSAVE2(IFN,1,"DELAYED ORDER") 209 .. S $P(^OR(100,IFN,8,1,0),U,15)="" D:$P(^(0),U,4)=2 SIGN^ORCSAVE2(IFN,"","",5,1) 210 D DONE(PTEVT),ACTLOG(PTEVT,"LP") 211 Q 1 OREVNTX ; SLC/MKB - Event delayed orders RPC's ; 08 May 2002 2:12 PM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997 3 ; 4 PAT(ORY,DFN) ; -- Returns currently delayed events for patient DFN 5 N EVT,CNT,X,Y S DFN=+$G(DFN),(EVT,CNT)=0 6 F S EVT=+$O(^ORE(100.2,"AE",DFN,EVT)) Q:EVT<1 S Y=+$O(^(EVT,0)) D 7 . I $G(^ORE(100.2,Y,1)) K ^ORE(100.2,"AE",DFN,EVT,Y) Q 8 . Q:$$LAPSED(Y) ;I $$EMPTY(Y) D CANCEL(Y) Q 9 . Q:$O(^ORE(100.2,"DAD",Y,0)) ;has children 10 . S X=$P($G(^ORD(100.5,EVT,0)),U,8),X="Delayed "_$$LOWER^VALM1(X) 11 . S CNT=CNT+1,ORY(CNT)=Y_U_X 12 S:CNT ORY(0)=CNT 13 Q 14 ; 15 EXISTS(DFN,EVT) ; -- Returns 1 if patient DFN has delayed orders for EVT, 16 ; or 2 if parent/sibling event has delayed orders, else 0 17 ; 18 N X,Y,I S Y=0 I '$G(DFN)!'$G(EVT) G EXQ 19 I $O(^ORE(100.2,"AE",+DFN,+EVT,0)) S Y=1 G EXQ 20 S X=+$P($G(^ORD(100.5,+EVT,0)),U,12) I X D G EXQ ;ck parent,siblings 21 . I $O(^ORE(100.2,"AE",+DFN,X,0)) S Y=2 Q 22 . S I=0 F S I=+$O(^ORD(100.5,"DAD",X,I)) Q:I<1 I $O(^ORE(100.2,"AE",+DFN,I,0)) S Y=2 Q 23 EXQ Q Y 24 ; 25 LIST(ORY,DFN) ; -- Returns all processed events for patient DFN as 26 ; ORY(#) = PatEvtIEN ^ Display Text ^ EvtDateTime 27 ; in reverse chronological order 28 N IDT,DA,CNT,X0,X1,EVT,DC,X 29 S DFN=+$G(DFN),(IDT,CNT)=0 30 F S IDT=$O(^ORE(100.2,"AC",DFN,IDT)) Q:IDT<1 D 31 . S DA=0 F S DA=+$O(^ORE(100.2,"AC",DFN,IDT,DA)) Q:DA<1 D 32 .. S X0=$G(^ORE(100.2,DA,0)),X1=$G(^(1)) Q:$P(X1,U,5) ;has parent 33 .. S EVT=+$P(X0,U,2),DC=+$P(X1,U,3) 34 .. I '$P(X0,U,4),'$O(^ORE(100.2,DA,2,0)),'$O(^ORE(100.2,DA,3,0)),'$D(^OR(100,"AEVNT",DFN_";DPT(",DA)) Q ;no orders 35 .. S I=+$O(^ORE(100.2,DA,10,"B"),-1),X=$P($G(^(I,0)),U,2) I X="LP"!(X="CA") Q ;lapsed or cancelled 36 .. ;Q if not current admission? 37 .. S X=$S(EVT:$P($G(^ORD(100.5,EVT,0)),U,8),DC:$P($G(^ORD(100.6,DC,0)),U,5),1:"UNSPECIFIED EVENT") 38 .. S X=$$LOWER^VALM1(X),CNT=CNT+1,ORY(CNT)=DA_U_X_U_$P(X1,U) 39 S:CNT ORY(0)=CNT 40 Q 41 ; 42 COMP(PTEVT) ; -- Returns 1 or 0, if PTEVT has been completed 43 N Y,I S Y=$S($G(^ORE(100.2,+$G(PTEVT),1)):1,1:0) 44 I Y S I=+$O(^ORE(100.2,+$G(PTEVT),10,0)) S:$P($G(^(I,0)),U,2)="CA" Y=0 45 Q Y 46 ; 47 ACTIVE(ORY,TYPE) ; -- Returns all active events [of TYPE] from #100.5 48 ; where TYPE=string containing any of the codes from the TYPE field 49 N NM,IEN,CNT,X0,X S CNT=0,TYPE=$G(TYPE) 50 S NM="" F S NM=$O(^ORD(100.5,"C",NM)) Q:NM="" D 51 . S IEN=0 F S IEN=+$O(^ORD(100.5,"C",NM,IEN)) Q:IEN<1 D 52 .. S X0=$G(^ORD(100.5,IEN,0)) I '$L($P(X0,U,2)) D ;Child event 53 ... S X=$P(X0,U,12) S:X $P(X0,U,2)=$P($G(^ORD(100.5,+X,0)),U,2) 54 .. I $L(TYPE),TYPE'[$P(X0,U,2) Q 55 .. Q:$O(^ORD(100.5,"DAD",IEN,0)) ;Parent event 56 .. S CNT=CNT+1,ORY(CNT)=IEN_U_X0 57 S:CNT ORY(0)=CNT 58 Q 59 ; 60 NAME(PTEVT) ; -- Return name of Patient Event 61 N X,Y,Z S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2),Z=$G(^(1)) 62 S:X Y=$P($G(^ORD(100.5,X,0)),U,8) 63 I 'X S X=+$P(Z,U,3),Y=$P($G(^ORD(100.6,X,0)),U,5) 64 S Y=$S('Z:"Delayed ",1:"")_$$LOWER^VALM1(Y) 65 Q Y 66 ; 67 SHORTNM(PTEVT) ; -- Return Short Name of Patient Event 68 ; or first 15 characters of Event Name if unspecified 69 N X,Y,Y0 S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) I X D 70 . S Y0=$G(^ORD(100.5,X,0)),Y=$P(Y0,U,10) 71 . S:'$L(Y) Y=$E($P(Y0,U,8),1,15) 72 I 'X S X=+$P($G(^ORE(100.2,+$G(PTEVT),1)),U,3),Y=$E($P($G(^ORD(100.6,X,0)),U,5),1,15) 73 Q Y 74 ; 75 EVT(PTEVT) ; -- Return Event ptr #100.5, given PTEVT ptr #100.2 76 Q +$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 77 ; 78 DC(PTEVT) ; -- Return DC Rule ptr #100.6, given PTEVT ptr #100.2 79 I $P($G(^ORE(100.2,+$G(PTEVT),1)),U,5) S PTEVT=$P(^(1),U,5) ;use parent 80 Q +$P($G(^ORE(100.2,+$G(PTEVT),1)),U,3) 81 ; 82 TYPE(PTEVT) ; -- Return Type of Patient Event (i.e. A/D/T) 83 N X,Y S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 84 I $P($G(^ORD(100.5,X,0)),U,12) S X=$P(^(0),U,12) ;use parent 85 S Y=$S(X:$P($G(^ORD(100.5,X,0)),U,2),1:"DC") 86 Q Y 87 ; 88 DIV(PTEVT) ; -- Return Division for PTEVT 89 N X,Y S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 90 I $P($G(^ORD(100.5,X,0)),U,12) S X=$P(^(0),U,12) ;use parent 91 S Y=+$P($G(^ORD(100.5,X,0)),U,3) S:Y<1 Y=+$G(DUZ(2)) 92 Q Y 93 ; 94 LOC(PTEVT) ; -- Return Default Ordering Location for PTEVT 95 N X,X0,Y S X=+$P($G(^ORE(100.2,+$G(PTEVT),0)),U,2) 96 S X0=$G(^ORD(100.5,X,0)),Y=+$P(X0,U,9)_";SC(" 97 I Y<1,$P(X0,U,12) S Y=+$P($G(^ORD(100.5,+$P(X0,U,12),0)),U,9)_";SC(" 98 S:Y<1 Y=$G(ORL) 99 Q Y 100 ; 101 EMPTY(PTEVT) ; -- Returns 1 or 0, if PTEVT has delayed orders 102 N Y,OR0,PAT,TYPE,PSO,IFN,STS S Y=1 I '$G(PTEVT) Q Y 103 S OR0=$G(^ORE(100.2,+PTEVT,0)),PAT=+$P(OR0,U)_";DPT(" 104 S TYPE=$$TYPE(PTEVT) I TYPE="D" S PSO=+$O(^DIC(9.4,"C","PSO",0)) 105 S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,PTEVT,IFN)) Q:IFN<1 D Q:'Y 106 . S STS=$P($G(^OR(100,IFN,3)),U,3) I STS=10 S Y=0 Q 107 . ;I IFN=+$P(OR0,U,4),STS=11!(STS=6) S Y=0 Q 108 . I TYPE="D",$P($G(^OR(100,IFN,0)),U,14)=PSO,STS=5!(STS=6) S Y=0 Q 109 I Y,$D(^ORE(100.2,"DAD",PTEVT)) D ;ck child events 110 . N CHLD S CHLD=0 111 . F S CHLD=+$O(^ORE(100.2,"DAD",PTEVT,CHLD)) Q:CHLD<1 D Q:'Y 112 .. S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,CHLD,IFN)) Q:IFN<1 I $P($G(^OR(100,IFN,3)),U,3)=10 S Y=0 Q 113 Q Y 114 ; 115 EVTORDER(ORDER) ; -- Returns 1 or 0, if ORDER is for event 116 ; Will return 0 if action DA is included but not NW 117 N X0,X,Y S X0=$G(^OR(100,+ORDER,0)),X=+$P(ORDER,";",2),Y=0 118 I $P(X0,U,17),X'>1 D 119 . I $P($G(^ORE(100.2,+$P(X0,U,17),0)),U,4)=+ORDER S Y=1 Q 120 . S DAD=+$P($G(^ORE(100.2,+$P(X0,U,17),1)),U,5) ;has parent? 121 . I DAD,$P($G(^ORE(100.2,DAD,0)),U,4)=+ORDER S Y=1 122 Q Y 123 ; 124 MANREL(ORDER) ; -- Returns 1 or 0, if ORDER was manually released 125 N EVT,Y,RELDT,TYPE,EVTDT S Y=0 126 S EVT=+$P($G(^OR(100,+ORDER,0)),U,17),RELDT=+$P($G(^(8,1,0)),U,16) 127 G:EVT<1 MNQ G:RELDT<1 MNQ ;not delayed or released 128 I '$D(^ORE(100.2,EVT,2,+ORDER)) S Y=1 G MNQ ;not rel'd by event 129 S TYPE=$$TYPE(EVT),EVTDT=+$G(^ORE(100.2,EVT,1)) 130 I TYPE="M",$$FMDIFF^XLFDT(EVTDT,RELDT,2)<300 S Y=1 131 MNQ Q Y 132 ; 133 CANCEL(PTEVT) ; -- Cancel empty PTEVT, event order 134 S PTEVT=+$G(PTEVT) D DONE(PTEVT),ACTLOG(PTEVT,"CA") 135 N IFN,DAD S IFN=+$P($G(^ORE(100.2,PTEVT,0)),U,4) 136 I IFN<1 D ;ck for parent w/event order 137 . S DAD=+$P($G(^ORE(100.2,PTEVT,1)),U,5) Q:DAD<1 138 . Q:'$G(^ORE(100.2,DAD,1)) ;parent still active 139 . S IFN=+$P($G(^ORE(100.2,DAD,0)),U,4) 140 I IFN D:'$$DCD^ORCACT2(IFN) CLRDLY^ORCACT2(IFN) ;cancel event order 141 Q 142 ; 143 DONE(PTEVT,WHEN,MVT,OR) ; -- Terminate PTEVT 144 Q:'$G(PTEVT) Q:'$D(^ORE(100.2,PTEVT,0)) 145 N X0,X1,PAT,EVT,DAD 146 S:'$G(WHEN) WHEN=+$E($$NOW^XLFDT,1,12) D D1 147 S DAD=$P(X1,U,5) I DAD,$$ALLDONE(DAD) S PTEVT=DAD D D1 Q 148 S DAD=PTEVT,PTEVT=0 ;if PTEVT=parent, terminate children too 149 F S PTEVT=+$O(^ORE(100.2,"DAD",DAD,PTEVT)) Q:PTEVT<1 D D1 150 Q 151 D1 S X0=$G(^ORE(100.2,+PTEVT,0)),X1=$G(^(1)) Q:'$L(X0) 152 S PAT=+$P(X0,U),EVT=+$P(X0,U,2) ;,ORD=+$P(X0,U,4) 153 S $P(X1,U,1,2)=WHEN_U_$G(MVT),$P(X1,U,4)=$G(OR),^ORE(100.2,PTEVT,1)=X1 154 S ^ORE(100.2,"AC",PAT,9999999-WHEN,PTEVT)="" 155 S:$G(OR) ^ORE(100.2,"ASR",OR,PTEVT)="" 156 K:EVT ^ORE(100.2,"AE",PAT,EVT,PTEVT) 157 Q 158 ; 159 ALLDONE(DAD) ; -- Returns 1 or 0, if all child events are done 160 N I,Y S Y=1,I=0 161 F S I=+$O(^ORE(100.2,"DAD",+$G(DAD),I)) Q:I<1 I '$G(^ORE(100.2,I,1)) S Y=0 Q 162 Q Y 163 ; 164 CHGEVT(IFN,NEWEVT) ; -- Change the Patient Event for order IFN to NEWEVT 165 ; Includes adding or removing event pointer to order 166 Q:'$G(IFN) N PAT,OLDEVT,OR3 S:$G(NEWEVT) NEWEVT=+NEWEVT 167 S PAT=$P($G(^OR(100,+IFN,0)),U,2),OLDEVT=$P($G(^(0)),U,17),OR3=$G(^(3)) 168 Q:OLDEVT=NEWEVT K:OLDEVT ^OR(100,"AEVNT",PAT,OLDEVT,+IFN) 169 S $P(^OR(100,+IFN,0),U,17)=NEWEVT S:NEWEVT ^OR(100,"AEVNT",PAT,NEWEVT,+IFN)="" 170 I NEWEVT,$P(OR3,U,3)'=10 S $P(^OR(100,+IFN,3),U,3)=10,$P(^(8,1,0),U,15)=10 171 I 'NEWEVT,$P(OR3,U,3)=10 S $P(^OR(100,+IFN,3),U,3)=11,$P(^(8,1,0),U,15)=11 D SET^ORDD100(+IFN,1) 172 Q 173 ; 174 ACTLOG(PTEVT,ACTION,EVTYPE,SAVE) ; -- Log a note for ACTION on PTEVT 175 ; SAVE => new data in VAIP() will be saved 176 Q:'$G(PTEVT) Q:'$D(^ORE(100.2,PTEVT,0)) Q:'$L($G(ACTION)) 177 N I,HDR,LAST,TOTAL,DA,ORNOW,MVT 178 F I=1:1:10 L +^ORE(100.2,PTEVT,10,0):1 Q:$T H 2 179 Q:'$T "^" S HDR=$G(^ORE(100.2,PTEVT,10,0)) S:'$L(HDR) HDR="^100.25DA^^" 180 S TOTAL=+$P(HDR,U,4),LAST=+$O(^ORE(100.2,PTEVT,10,"B"),-1) 181 S I=LAST F I=(I+1):1 Q:'$D(^ORE(100.2,PTEVT,10,I,0)) 182 S DA=I,$P(HDR,U,3,4)=DA_U_(TOTAL+1) 183 S ^ORE(100.2,PTEVT,10,0)=HDR L -^ORE(100.2,PTEVT,10,0) 184 S ORNOW=+$$NOW^XLFDT,^ORE(100.2,PTEVT,10,"B",ORNOW,DA)="" 185 S ^ORE(100.2,PTEVT,10,DA,0)=ORNOW_U_ACTION_U_$S(ACTION="LP":"",1:$G(DUZ))_U_$G(EVTYPE) 186 S MVT=+$P($G(^ORE(100.2,PTEVT,1)),U,2) 187 S:MVT ^ORE(100.2,"ADT",MVT,ORNOW,PTEVT,DA)="" 188 I $G(SAVE),$G(VAIP(4)) S $P(^ORE(100.2,PTEVT,10,DA,0),U,5,7)=+VAIP(4)_U_+VAIP(8)_U_+VAIP(5) 189 Q 190 ; 191 LAPSED(PTEVT) ; -- Ck if PTEVT has lapsed, if so lapse all orders 192 N Y,X0,EVT,ENTERED,DAYS S Y=0 193 I $G(^ORE(100.2,PTEVT,1)) G LPQ ;already terminated 194 S X0=$G(^ORE(100.2,PTEVT,0)),EVT=+$P(X0,U,2),ENTERED=+$P(X0,U,5) 195 S:$P($G(^ORD(100.5,EVT,0)),U,12) EVT=+$P(^(0),U,12) ;parent 196 S DAYS=+$P($G(^ORD(100.5,EVT,0)),U,6) I DAYS<1 G LPQ ;doesn't lapse 197 I ENTERED>$$FMADD^XLFDT(DT,(0-DAYS)) G LPQ ;not lapsed yet 198 D LP1(PTEVT) S Y=1 ;lapse orders, event 199 LPQ Q Y 200 ; 201 LP1(PTEVT) ; -- Lapse orders, event PTEVT 202 N X0,PAT,IFN,STS 203 S X0=$G(^ORE(100.2,PTEVT,0)),PAT=+$P(X0,U)_";DPT(" 204 S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,PTEVT,IFN)) Q:IFN<1 D 205 . S STS=$P($G(^OR(100,IFN,3)),U,3) I (STS=10)!(STS=11)!(IFN=+$P(X0,U,4)) D 206 .. D STATUS^ORCSAVE2(IFN,14) 207 .. S $P(^OR(100,IFN,8,1,0),U,15)="" D:$P(^(0),U,4)=2 SIGN^ORCSAVE2(IFN,"","",5,1) 208 D DONE(PTEVT),ACTLOG(PTEVT,"LP") 209 Q
Note:
See TracChangeset
for help on using the changeset viewer.
