- 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/ORWORR.m
r613 r623 1 ORWORR ; SLC/KCM/JLI - Retrieve Orders for Broker ;7/24/05 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,92,116,110,132,141,163,189,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 GET(LST,DFN,FILTER,GROUPS) ; procedure 5 Q ; don't call until using same treating specialty logic as AGET 6 ; & until MULT, ORWARD, & ORIGVIEW implemented 7 ; & until the date ranges implemented 8 ; Get orders for patient 9 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 10 ; .LST=~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^^Schedule 11 ; .LST=tOrder Text (repeating as necessary) 12 ; DFN=Patient ID 13 ; FILTER=# indicates which orders to return, default=2 (current) 14 ; GROUPS=display grp of orders to show (default=ALL) 15 ; -- section uses ORQ1 to get orders list rather than XGET -- 16 N ORLIST,ORIFN,X0,X3,X8,IDX,IFN,ACT,PRV,LN,TXT,STRT,STOP,CSTS,EYE,DEA ;PKI 17 K ^TMP("ORR",$J) 18 S (IDX,LST)=0 S:'$D(GROUPS) GROUPS=1 S:'$D(FILTER) FILTER=2 19 D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"","","",0,1) 20 S EYE=0 F S EYE=$O(^TMP("ORR",$J,ORLIST,EYE)) Q:'EYE S IFN=^(EYE) D 21 . S ACT=$P(IFN,";",2),IFN=+IFN,X0=^OR(100,IFN,0),X3=^(3),X8=^(8,ACT,0) 22 . D GETFLDS 23 K ^TMP("ORR",$J) 24 G EXIT 25 AGET(REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT,ORRECIP) ;Get abbrev. event delayed order list for patient 26 ; returns ^TMP("ORR",$J,ORLIST,n)=IFN^DGrp^ActTm 27 ; see input parameters above 28 ; -- from ORWORR 29 ; -- section uses ORQ1 to get orders list rather than XGET -- 30 N ORLIST,ORIFN,IFN,I,ORWTS,TOT,MULT,ORWARD,TXTVW,ORYD,PTEVTID,EVTNAME 31 S (PTEVTID,EVTNAME)="" 32 K ^TMP("ORR",$J),^TMP("ORRJD",$J) 33 S:'$D(GROUPS) GROUPS=1 S:'$D(FILTER) FILTER=2 34 S ORWTS=+$P(FILTER,U,2),FILTER=+FILTER 35 S MULT=$S("^1^6^8^9^10^11^13^14^20^22^"[(U_FILTER_U):1,1:0) 36 I $L($G(^DPT(DFN,.1))) S ORWARD=1 ; normally ptr to 42 37 S:'$L($G(DTFROM)) DTFROM=0 38 S:'$L($G(DTTHRU)) DTTHRU=0 39 I $P(DTFROM,".")=$P(DTTHRU,"."),$P(DTFROM,".",2)>$P(DTTHRU,".",2),$P(DTTHRU,".",2)="" S $P(DTTHRU,".",2)=2359 40 S:'$L($G(EVENT)) EVENT=0 41 I $G(EVTDCREL)="TRUE" D 42 . D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"",DTFROM,DTTHRU,2,MULT,"",1,EVENT) 43 . D GET2^ORWORR1 44 E D 45 . D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"",DTFROM,DTTHRU,0,MULT,"",1,EVENT) 46 . D GET1^ORWORR1 47 Q 48 RGET(REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT) ;Orders of AutoDC/Release Event 49 N EVTDCREL 50 S EVTDCREL="TRUE" 51 D AGET(.REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT) 52 Q 53 XGET ; retrieval algorithm before all the AC xref changes 54 N X,X0,X3,IDX,IFN,LN,TIME,DGRP,MASK,TXT,ACT,PRV,ID,DEA,PASS ;PKI 55 S DFN=DFN_";DPT(",IDX=0,LST=0 56 I '$G(FILTER) S FILTER=2 ; Default: Current/Active 57 I $D(GROUPS)=1 D 58 . S:'GROUPS GROUPS=$O(^ORD(100.98,"B",GROUPS,0)) 59 . D XPND(GROUPS) 60 I FILTER=1 D DOALL G EXIT ; All 61 I FILTER=2 D DOCUR G EXIT ; Current 62 I FILTER=3 S PASS=";1;" ; Discontinued 63 I FILTER=4 S PASS=";2;7;" ; Comp/Expired 64 I FILTER=5 S PASS=";3;4;5;6;8;9;" ; Expiring 65 I FILTER=6 S PASS=";1;2;3;4;5;6;7;8;9;11;" ; New Activity 66 I FILTER=7 S PASS=";5;" ; Pending 67 I FILTER=8 Q ; Expanded 68 I FILTER=9 S PASS=";3;4;5;6;8;9;11;" ; Unverified by Nurse 69 I FILTER=10 S PASS=";3;4;5;6;8;9;11;" ; Unverified by Clerk 70 I FILTER=11 S PASS=";3;4;5;6;7;8;11;" ; Unsigned 71 I FILTER=12 S PASS=";4;" ; Flagged 72 I FILTER=13 S PASS="" ; Verbal/Phone 73 I FILTER=14 S PASS="" ; Verbal/Phone Unsigned 74 D DOGET 75 EXIT I LST=0 D 76 . N %,X,%I D NOW^%DTC 77 . S LST(1)="~0^0^"_%_"^^^97",LST(2)="tNo Orders Found." 78 Q 79 DOGET ; Here to filter orders 80 S TIME=0 F S TIME=$O(^OR(100,"AO",DFN,TIME)) Q:'TIME D 81 . S DGRP=0 F S DGRP=$O(^OR(100,"AO",DFN,TIME,DGRP)) Q:'DGRP D 82 . . I $D(GROUPS)>1 Q:'$D(GROUPS(DGRP)) ;filter by display grp 83 . . S IFN=0 F S IFN=$O(^OR(100,"AO",DFN,TIME,DGRP,IFN)) Q:'IFN D 84 . . . S X0=^OR(100,IFN,0),X3=^(3) ;get main nodes 85 . . . I $P(X3,U,8)!$P(X3,U,9)!($P(X3,U,3)=99) Q ;skip veil,chld,sts=99 86 . . . I $L(PASS),(PASS'[(";"_$P(X3,U,3)_";")) Q ;filter by status 87 . . . ; any other filtering 88 . . . D GETFLDS 89 Q 90 DOALL ; Here to get all orders (no filter by status) 91 S TIME=0 F S TIME=$O(^OR(100,"AO",DFN,TIME)) Q:'TIME D 92 . S DGRP=0 F S DGRP=$O(^OR(100,"AO",DFN,TIME,DGRP)) Q:'DGRP D 93 . . I $D(GROUPS)>1 Q:'$D(GROUPS(DGRP)) ;filter by display grp 94 . . S IFN=0 F S IFN=$O(^OR(100,"AO",DFN,TIME,DGRP,IFN)) Q:'IFN D 95 . . . S X0=^OR(100,IFN,0),X3=^(3) ;get main nodes 96 . . . I $P(X3,U,8)!$P(X3,U,9)!($P(X3,U,3)=99) Q ;skip veil,chld,sts=99 97 . . . D GETFLDS 98 Q 99 DOCUR ; Here to get all current orders 100 N AOCTXT,STS,STOP,% 101 S X=-$$GET^XPAR("ALL","ORPF ACTIVE ORDERS CONTEXT HRS") 102 S %H=$H,X=(%H*86400+$P(%H,",",2))+(X*3600),%H=(X\86400)_","_(X#86400) 103 D YMD^%DTC S AOCTXT=X_% 104 S MASK="110000100101110" ; mask out STS=1,2,7,10,12,13,14 105 S TIME=0 F S TIME=$O(^OR(100,"AC",DFN,TIME)) Q:'TIME D 106 . S IFN=0 F S IFN=$O(^OR(100,"AC",DFN,TIME,IFN)) Q:'IFN D 107 . . ; filter out display groups here 108 . . S ACT=0 F S ACT=$O(^OR(100,"AC",DFN,TIME,IFN,ACT)) Q:'ACT D 109 . . . S X0=^OR(100,IFN,0),X3=^(3),X8=^(8,ACT,0) 110 . . . S STS=$P(X3,U,3),STOP=$P(X0,U,9) 111 . . . I $P(X3,U,8)!$P(X3,U,9)!(STS=99) Q 112 . . . I $P(X8,U,15)=13,($P(X8,U)<AOCTXT) D ACKILL Q 113 . . . I $P(X8,U,15)=13!($P(X8,U,15)=""),("RN^XX"[$P(X8,U,2)) D ACKILL Q 114 . . . I $E(MASK,STS),STOP<AOCTXT D ACKILL Q 115 . . . D GETFLDS 116 Q 117 ACKILL ; called only from DOCUR - kill AC xref 118 ; K ^OR(100,"AC",DFN,TIME,IFN,ACT) ; let ORQ1 kill if for now 119 Q 120 GET4V11(LST,TXTVW,ORYD,IFNLST) ; get order fields TEMP 121 G GET41 122 GET4LST(LST,IFNLST) ; get order fields for list of orders 123 GET41 N ACT,ACTID,IDX,X0,X3,X8,PRV,ID,LN,TXT,STRT,STOP,CSTS,IFN,IFNIDX,ORIGVIEW,DEA ;PKI 124 N LOC ;IMO 125 S (IDX,LST,IFNIDX)=0 126 F S IFNIDX=$O(IFNLST(IFNIDX)) Q:'IFNIDX S IFN=IFNLST(IFNIDX) D 127 . S ACT=$S($P(IFN,";",2):$P(IFN,";",2),1:1),IFN=+IFN 128 . S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X8=$G(^(8,ACT,0)) 129 . D GETFLDS 130 Q 131 GETBYIFN(LST,IFN) ; procedure 132 ; get fields for single order 133 ; .LST(n)=described above in GET 134 ; IFN=internal entry # for order 135 I 'IFN Q 136 N ACT,IDX,X0,X3,X8,PRV,ID,LN,TXT,STRT,STOP,CSTS,ACTID,ORIGVIEW,ORYD,TXTVW,DEA ;PKI 137 S IDX=0,LST=0,ORYD=0 138 S X0=$G(^OR(100,+IFN,0)),X3=$G(^(3)) 139 S ACT=$S($P(IFN,";",2):$P(IFN,";",2),$P(X3,U,7):$P(X3,U,7),1:1) 140 S IFN=+IFN,X8=$G(^OR(100,IFN,8,ACT,0)) 141 GETFLDS ; used by entry points to place order fields into list 142 ; expects IDX=sequence #, IFN=order, X0=node 0, X3=node 3, LST=results 143 ; LST(IDX)=~IFN^Grp^OrdTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^Act^Flagged[^DCType]^ChartRev^DEA#^^DigSig^LOC 144 S PRV=$P(X8,U,5) S:'PRV PRV=$P(X8,U,3) S PRV=PRV_U 145 I PRV S PRV=PRV_$P(^VA(200,+PRV,0),U) 146 S DEA=$$DEA^XUSER(,+PRV) ; get user DEA info - PKI 147 S IDX=IDX+1,LST=LST+1,ID=IFN_";"_ACT,ACTID=$P(X8,U,2) 148 S CSTS=$S($P(X8,U,15):$P(X8,U,15),1:$P(X3,U,3)) 149 I $P(X8,U,15)=10,$P(X3,U,3)=14 S CSTS=14 ;delayed-lapsed order 150 S STRT=$S($P(X3,U,3)=11:$$RSTRT,ACTID="NW"!(ACTID="XX")!(ACTID="RL"):$P(X0,U,8),ACTID="DC":"",1:$P(X8,U)) ;110 151 S STOP=$S($P(X3,U,3)=11:$$RSTOP,ACTID="HD":$P($G(^OR(100,+IFN,8,ACT,2)),U),1:$P(X0,U,9)) 152 S LST(IDX)="~"_ID_U_$P(X0,U,11)_U_$P(X8,U)_U_STRT_U_STOP_U_CSTS_U_$P(X8,U,4)_U_$P(X8,U,8)_U_$P(X8,U,10)_U_PRV 153 S $P(LST(IDX),U,13)=+$G(^OR(100,IFN,8,ACT,3)) ; flagged 154 I +$P(X8,U,8) S $P(LST(IDX),U,8)=$$INITIALS^ORCHTAB2(+$P(X8,U,8)) ;nurse 155 I +$P(X8,U,10) S $P(LST(IDX),U,9)=$$INITIALS^ORCHTAB2(+$P(X8,U,10)) ;clerk 156 I +$P(X8,U,18) S $P(LST(IDX),U,15)=$$INITIALS^ORCHTAB2(+$P(X8,U,18)) ;chart review 157 I $L($G(DEA)) S $P(LST(IDX),U,16)=DEA ;PKI 158 I $P($G(^OR(100,IFN,8,ACT,2)),"^",5) S $P(LST(IDX),U,18)=$P(^(2),"^",4) 159 I '$P($G(^OR(100,IFN,8,ACT,2)),"^",5),$P(X0,"^",5) D ;Copy orders PKI fix 160 . N OI,ORVP,ORCAT,PKG 161 . S OI=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0)),OI=+$G(^OR(100,IFN,4.5,OI,1)) Q:'OI 162 . S ORVP=$P(X0,"^",2),PKG=$P(X0,"^",14) 163 . S ORCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O") 164 . I PKG'=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) Q 165 . D PKI^ORWDPS1(.ORY,OI,ORCAT,+ORVP,$$GET^XPAR("ALL^USR.`"_DUZ,"ORWOR PKI USE",1,"Q")) 166 . I $E($G(ORY))=2 S $P(LST(IDX),U,18)=ORY 167 ; Change to display location for Clinic Orders, Inpatients, & IV infusion orders. 168 N DGID,DGNAM 169 S LOC="" 170 S DGID=$P(X0,U,11) 171 I $L(DGID) D 172 .S DGNAM=$P($G(^ORD(100.98,DGID,0)),U) 173 .;I DGNAM="CLINIC ORDERS"!(DGNAM="INPATIENT MEDICATIONS")!(DGNAM="IV MEDICATIONS")!(DGNAM="UNIT DOSE MEDICATIONS") D 174 .S LOC=$P(X0,U,10) ;IMO 175 .S:+LOC LOC=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO 176 S $P(LST(IDX),U,19)=LOC ;IMO 177 ; 178 S ORIGVIEW=$S($G(TXTVW)=0:0,$G(TXTVW)=1:1,ORYD=-1:1,'ORYD:1,$P(X8,U)'<ORYD:0,1:1) 179 K TXT D TEXT^ORQ12(.TXT,ID,255) ; optimize later 180 I $O(^OR(100,+IFN,2,0)) S LN=$O(TXT(0)),TXT(LN)="+"_TXT(LN) 181 I $O(^OR(100,+IFN,8,"C","XX",0)) S LN=$O(TXT(0)),TXT(LN)="*"_TXT(LN) 182 S LN=0 F S LN=$O(TXT(LN)) Q:'LN S IDX=IDX+1,LST(IDX)="t"_TXT(LN) 183 I $O(^OR(100,+IFN,8,1,.2,0)) S IDX=IDX+1,LST(IDX)="|" D ;PKI XMLText 184 . S I=0 F S I=$O(^OR(100,+IFN,8,1,.2,I)) Q:'I S IDX=IDX+1,LST(IDX)="x"_^(I,0) 185 Q 186 RSTRT() ; return start date from responses 187 Q $G(^OR(100,IFN,4.5,+$O(^OR(100,IFN,4.5,"ID","START",0)),1)) 188 RSTOP() ; return stop date from responses 189 Q $G(^OR(100,IFN,4.5,+$O(^OR(100,IFN,4.5,"ID","STOP",0)),1)) 190 GETTXT(LST,IFN) ; get text of an order 191 I $L(IFN,";")=1 S IFN=IFN_";1" 192 D TEXT^ORQ12(.LST,IFN,255) 193 Q 194 XPND(AGRP) ; procedure 195 ; Expand display group (GROUPS defined outside of call) 196 N I,CHLD 197 S GROUPS(AGRP)=^ORD(100.98,AGRP,0),I=0 198 F S I=$O(^ORD(100.98,AGRP,1,I)) Q:'I S CHLD=$P(^(I,0),U) D XPND(CHLD) 199 Q 200 GETPKG(Y,IFN) ; get order pkg 201 N ORDERID,PKGID 202 Q:+IFN<1 203 S ORDERID=+IFN,Y="" 204 S PKGID=$P(OR(100,ORDERID,0),U,14) 205 S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2) 206 Q 1 ORWORR ; SLC/KCM/JLI - Retrieve Orders for Broker ;7/24/05 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,92,116,110,132,141,163,189,195,215**;Dec 17, 1997 3 ; 4 GET(LST,DFN,FILTER,GROUPS) ; procedure 5 Q ; don't call until using same treating specialty logic as AGET 6 ; & until MULT, ORWARD, & ORIGVIEW implemented 7 ; & until the date ranges implemented 8 ; Get orders for patient 9 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 10 ; .LST=~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^^Schedule 11 ; .LST=tOrder Text (repeating as necessary) 12 ; DFN=Patient ID 13 ; FILTER=# indicates which orders to return, default=2 (current) 14 ; GROUPS=display grp of orders to show (default=ALL) 15 ; -- this section uses ORQ1 to get orders list rather than XGET -- 16 N ORLIST,ORIFN,X0,X3,X8,IDX,IFN,ACT,PRV,LN,TXT,STRT,STOP,CSTS,EYE,DEA ;PKI 17 K ^TMP("ORR",$J) 18 S (IDX,LST)=0 S:'$D(GROUPS) GROUPS=1 S:'$D(FILTER) FILTER=2 19 D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"","","",0,1) 20 S EYE=0 F S EYE=$O(^TMP("ORR",$J,ORLIST,EYE)) Q:'EYE S IFN=^(EYE) D 21 . S ACT=$P(IFN,";",2),IFN=+IFN,X0=^OR(100,IFN,0),X3=^(3),X8=^(8,ACT,0) 22 . D GETFLDS 23 K ^TMP("ORR",$J) 24 G EXIT 25 AGET(REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT) ;Get an abbrev. event delayed order list for patient 26 ; returns ^TMP("ORR",$J,ORLIST,n)=IFN^DGrp^ActTm 27 ; see input parameters above 28 ; -- from ORWORR 29 ; -- section uses ORQ1 to get the orders list rather than XGET -- 30 N ORLIST,ORIFN,IFN,I,ORWTS,TOT,MULT,ORWARD,TXTVW,ORYD,PTEVTID,EVTNAME 31 S (PTEVTID,EVTNAME)="" 32 K ^TMP("ORR",$J),^TMP("ORRJD",$J) 33 S:'$D(GROUPS) GROUPS=1 S:'$D(FILTER) FILTER=2 34 S ORWTS=+$P(FILTER,U,2),FILTER=+FILTER 35 S MULT=$S("^1^6^8^9^10^11^13^14^20^22^"[(U_FILTER_U):1,1:0) 36 I $L($G(^DPT(DFN,.1))) S ORWARD=1 ; normally ptr to 42 37 S:'$L($G(DTFROM)) DTFROM=0 38 S:'$L($G(DTTHRU)) DTTHRU=0 39 S:'$L($G(EVENT)) EVENT=0 40 I $G(EVTDCREL)="TRUE" D 41 . D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"",DTFROM,DTTHRU,2,MULT,"",1,EVENT) 42 . D GET2^ORWORR1 43 E D 44 . D EN^ORQ1(DFN_";DPT(",GROUPS,FILTER,"",DTFROM,DTTHRU,0,MULT,"",1,EVENT) 45 . D GET1^ORWORR1 46 Q 47 RGET(REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT) ;Orders of AutoDC/Release Event 48 N EVTDCREL 49 S EVTDCREL="TRUE" 50 D AGET(.REF,DFN,FILTER,GROUPS,DTFROM,DTTHRU,EVENT) 51 Q 52 XGET ; -- the retrieval algorithm before all the AC xref changes 53 N X,X0,X3,IDX,IFN,LN,TIME,DGRP,MASK,TXT,ACT,PRV,ID,DEA,PASS ;PKI 54 S DFN=DFN_";DPT(",IDX=0,LST=0 55 I '$G(FILTER) S FILTER=2 ; Default: Current/Active 56 I $D(GROUPS)=1 D 57 . S:'GROUPS GROUPS=$O(^ORD(100.98,"B",GROUPS,0)) 58 . D XPND(GROUPS) 59 I FILTER=1 D DOALL G EXIT ; All 60 I FILTER=2 D DOCUR G EXIT ; Current 61 I FILTER=3 S PASS=";1;" ; Discontinued 62 I FILTER=4 S PASS=";2;7;" ; Comp/Expired 63 I FILTER=5 S PASS=";3;4;5;6;8;9;" ; Expiring 64 I FILTER=6 S PASS=";1;2;3;4;5;6;7;8;9;11;" ; New Activity 65 I FILTER=7 S PASS=";5;" ; Pending 66 I FILTER=8 Q ; Expanded 67 I FILTER=9 S PASS=";3;4;5;6;8;9;11;" ; Unverified by Nurse 68 I FILTER=10 S PASS=";3;4;5;6;8;9;11;" ; Unverified by Clerk 69 I FILTER=11 S PASS=";3;4;5;6;7;8;11;" ; Unsigned 70 I FILTER=12 S PASS=";4;" ; Flagged 71 I FILTER=13 S PASS="" ; Verbal/Phone 72 I FILTER=14 S PASS="" ; Verbal/Phone Unsigned 73 D DOGET 74 EXIT I LST=0 D 75 . N %,X,%I D NOW^%DTC 76 . S LST(1)="~0^0^"_%_"^^^97",LST(2)="tNo Orders Found." 77 Q 78 DOGET ; Come here to filter orders 79 S TIME=0 F S TIME=$O(^OR(100,"AO",DFN,TIME)) Q:'TIME D 80 . S DGRP=0 F S DGRP=$O(^OR(100,"AO",DFN,TIME,DGRP)) Q:'DGRP D 81 . . I $D(GROUPS)>1 Q:'$D(GROUPS(DGRP)) ;filter by display grp 82 . . S IFN=0 F S IFN=$O(^OR(100,"AO",DFN,TIME,DGRP,IFN)) Q:'IFN D 83 . . . S X0=^OR(100,IFN,0),X3=^(3) ;get main nodes 84 . . . I $P(X3,U,8)!$P(X3,U,9)!($P(X3,U,3)=99) Q ;skip veil,chld,sts=99 85 . . . I $L(PASS),(PASS'[(";"_$P(X3,U,3)_";")) Q ;filter by status 86 . . . ; do any other filtering 87 . . . D GETFLDS 88 Q 89 DOALL ; Come here to get all orders (no filter by status) 90 S TIME=0 F S TIME=$O(^OR(100,"AO",DFN,TIME)) Q:'TIME D 91 . S DGRP=0 F S DGRP=$O(^OR(100,"AO",DFN,TIME,DGRP)) Q:'DGRP D 92 . . I $D(GROUPS)>1 Q:'$D(GROUPS(DGRP)) ;filter by display grp 93 . . S IFN=0 F S IFN=$O(^OR(100,"AO",DFN,TIME,DGRP,IFN)) Q:'IFN D 94 . . . S X0=^OR(100,IFN,0),X3=^(3) ;get main nodes 95 . . . I $P(X3,U,8)!$P(X3,U,9)!($P(X3,U,3)=99) Q ;skip veil,chld,sts=99 96 . . . D GETFLDS 97 Q 98 DOCUR ; Come here to get all current orders 99 N AOCTXT,STS,STOP,% 100 S X=-$$GET^XPAR("ALL","ORPF ACTIVE ORDERS CONTEXT HRS") 101 S %H=$H,X=(%H*86400+$P(%H,",",2))+(X*3600),%H=(X\86400)_","_(X#86400) 102 D YMD^%DTC S AOCTXT=X_% 103 S MASK="110000100101110" ; mask out STS=1,2,7,10,12,13,14 104 S TIME=0 F S TIME=$O(^OR(100,"AC",DFN,TIME)) Q:'TIME D 105 . S IFN=0 F S IFN=$O(^OR(100,"AC",DFN,TIME,IFN)) Q:'IFN D 106 . . ; filter out display groups here 107 . . S ACT=0 F S ACT=$O(^OR(100,"AC",DFN,TIME,IFN,ACT)) Q:'ACT D 108 . . . S X0=^OR(100,IFN,0),X3=^(3),X8=^(8,ACT,0) 109 . . . S STS=$P(X3,U,3),STOP=$P(X0,U,9) 110 . . . I $P(X3,U,8)!$P(X3,U,9)!(STS=99) Q 111 . . . I $P(X8,U,15)=13,($P(X8,U)<AOCTXT) D ACKILL Q 112 . . . I $P(X8,U,15)=13!($P(X8,U,15)=""),("RN^XX"[$P(X8,U,2)) D ACKILL Q 113 . . . I $E(MASK,STS),STOP<AOCTXT D ACKILL Q 114 . . . D GETFLDS 115 Q 116 ACKILL ; called only from DOCUR - kill AC xref 117 ; K ^OR(100,"AC",DFN,TIME,IFN,ACT) ; let ORQ1 kill if for now 118 Q 119 GET4V11(LST,TXTVW,ORYD,IFNLST) ; get order fields TEMPORARY 120 G GET41 121 GET4LST(LST,IFNLST) ; get order fields for a list of orders 122 GET41 N ACT,ACTID,IDX,X0,X3,X8,PRV,ID,LN,TXT,STRT,STOP,CSTS,IFN,IFNIDX,ORIGVIEW,DEA ;PKI 123 N LOC ;IMO 124 S (IDX,LST,IFNIDX)=0 125 F S IFNIDX=$O(IFNLST(IFNIDX)) Q:'IFNIDX S IFN=IFNLST(IFNIDX) D 126 . S ACT=$S($P(IFN,";",2):$P(IFN,";",2),1:1),IFN=+IFN 127 . S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X8=$G(^(8,ACT,0)) 128 . D GETFLDS 129 Q 130 GETBYIFN(LST,IFN) ; procedure 131 ; get fields for single order 132 ; .LST(n)=as described above in GET 133 ; IFN=internal entry # for order 134 I 'IFN Q 135 N ACT,IDX,X0,X3,X8,PRV,ID,LN,TXT,STRT,STOP,CSTS,ACTID,ORIGVIEW,ORYD,TXTVW,DEA ;PKI 136 S IDX=0,LST=0,ORYD=0 137 S X0=$G(^OR(100,+IFN,0)),X3=$G(^(3)) 138 S ACT=$S($P(IFN,";",2):$P(IFN,";",2),$P(X3,U,7):$P(X3,U,7),1:1) 139 S IFN=+IFN,X8=$G(^OR(100,IFN,8,ACT,0)) 140 GETFLDS ; used by entry points to place order fields into list 141 ; expects IDX=sequence #, IFN=order, X0=node 0, X3=node 3, LST=results 142 ; LST(IDX)=~IFN^Grp^OrdTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^Act^Flagged[^DCType]^ChartRev^DEA#^^DigSig^LOC 143 S PRV=$P(X8,U,5) S:'PRV PRV=$P(X8,U,3) S PRV=PRV_U 144 I PRV S PRV=PRV_$P(^VA(200,+PRV,0),U) 145 S DEA=$$DEA^XUSER(,+PRV) ; get user DEA info - PKI 146 S IDX=IDX+1,LST=LST+1,ID=IFN_";"_ACT,ACTID=$P(X8,U,2) 147 S CSTS=$S($P(X8,U,15):$P(X8,U,15),1:$P(X3,U,3)) 148 I $P(X8,U,15)=10,$P(X3,U,3)=14 S CSTS=14 ;delayed-lapsed order 149 S STRT=$S($P(X3,U,3)=11:$$RSTRT,ACTID="NW"!(ACTID="XX")!(ACTID="RL"):$P(X0,U,8),ACTID="DC":"",1:$P(X8,U)) ;110 150 S STOP=$S($P(X3,U,3)=11:$$RSTOP,ACTID="HD":$P($G(^OR(100,+IFN,8,ACT,2)),U),1:$P(X0,U,9)) 151 S LST(IDX)="~"_ID_U_$P(X0,U,11)_U_$P(X8,U)_U_STRT_U_STOP_U_CSTS_U_$P(X8,U,4)_U_$P(X8,U,8)_U_$P(X8,U,10)_U_PRV 152 S $P(LST(IDX),U,13)=+$G(^OR(100,IFN,8,ACT,3)) ; flagged 153 I +$P(X8,U,8) S $P(LST(IDX),U,8)=$$INITIALS^ORCHTAB2(+$P(X8,U,8)) ;nurse 154 I +$P(X8,U,10) S $P(LST(IDX),U,9)=$$INITIALS^ORCHTAB2(+$P(X8,U,10)) ;clerk 155 I +$P(X8,U,18) S $P(LST(IDX),U,15)=$$INITIALS^ORCHTAB2(+$P(X8,U,18)) ;chart review 156 I $L($G(DEA)) S $P(LST(IDX),U,16)=DEA ;PKI 157 I $P($G(^OR(100,IFN,8,ACT,2)),"^",5) S $P(LST(IDX),U,18)=$P(^(2),"^",4) 158 I '$P($G(^OR(100,IFN,8,ACT,2)),"^",5),$P(X0,"^",5) D ;Copy orders PKI fix 159 . N OI,ORVP,ORCAT,PKG 160 . S OI=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0)),OI=+$G(^OR(100,IFN,4.5,OI,1)) Q:'OI 161 . S ORVP=$P(X0,"^",2),PKG=$P(X0,"^",14) 162 . S ORCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O") 163 . I PKG'=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) Q 164 . D PKI^ORWDPS1(.ORY,OI,ORCAT,+ORVP,$$GET^XPAR("ALL^USR.`"_DUZ,"ORWOR PKI USE",1,"Q")) 165 . I $E($G(ORY))=2 S $P(LST(IDX),U,18)=ORY 166 ; Change code to display location for Clinic Orders, Inpatients, and IV infusion orders. 167 N DGID,DGNAM 168 S LOC="" 169 S DGID=$P(X0,U,11) 170 I $L(DGID) D 171 .S DGNAM=$P($G(^ORD(100.98,DGID,0)),U) 172 .;I DGNAM="CLINIC ORDERS"!(DGNAM="INPATIENT MEDICATIONS")!(DGNAM="IV MEDICATIONS")!(DGNAM="UNIT DOSE MEDICATIONS") D 173 .S LOC=$P(X0,U,10) ;IMO 174 .S:+LOC LOC=$P($G(^SC(+LOC,0)),U)_":"_+LOC ;IMO 175 S $P(LST(IDX),U,19)=LOC ;IMO 176 ; 177 S ORIGVIEW=$S($G(TXTVW)=0:0,$G(TXTVW)=1:1,ORYD=-1:1,'ORYD:1,$P(X8,U)'<ORYD:0,1:1) 178 K TXT D TEXT^ORQ12(.TXT,ID,255) ; optimize this later 179 I $O(^OR(100,+IFN,2,0)) S LN=$O(TXT(0)),TXT(LN)="+"_TXT(LN) 180 I $O(^OR(100,+IFN,8,"C","XX",0)) S LN=$O(TXT(0)),TXT(LN)="*"_TXT(LN) 181 S LN=0 F S LN=$O(TXT(LN)) Q:'LN S IDX=IDX+1,LST(IDX)="t"_TXT(LN) 182 I $O(^OR(100,+IFN,8,1,.2,0)) S IDX=IDX+1,LST(IDX)="|" D ;PKI XMLText 183 . S I=0 F S I=$O(^OR(100,+IFN,8,1,.2,I)) Q:'I S IDX=IDX+1,LST(IDX)="x"_^(I,0) 184 Q 185 RSTRT() ; return start date from responses 186 Q $G(^OR(100,IFN,4.5,+$O(^OR(100,IFN,4.5,"ID","START",0)),1)) 187 RSTOP() ; return stop date from responses 188 Q $G(^OR(100,IFN,4.5,+$O(^OR(100,IFN,4.5,"ID","STOP",0)),1)) 189 GETTXT(LST,IFN) ; get the text of an order 190 I $L(IFN,";")=1 S IFN=IFN_";1" 191 D TEXT^ORQ12(.LST,IFN,255) 192 Q 193 XPND(AGRP) ; procedure 194 ; Expand a display group (GROUPS must be defined outside of call) 195 N I,CHLD 196 S GROUPS(AGRP)=^ORD(100.98,AGRP,0),I=0 197 F S I=$O(^ORD(100.98,AGRP,1,I)) Q:'I S CHLD=$P(^(I,0),U) D XPND(CHLD) 198 Q 199 GETPKG(Y,IFN) ; get pkg for order 200 N ORDERID,PKGID 201 Q:+IFN<1 202 S ORDERID=+IFN,Y="" 203 S PKGID=$P(OR(100,ORDERID,0),U,14) 204 S:PKGID>0 Y=$P(^DIC(9.4,PKGID,0),U,2) 205 Q
Note:
See TracChangeset
for help on using the changeset viewer.
