- 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/ORQ11.m
r613 r623 1 ORQ11 ;slc/dcm-Get patient orders in context ;3/31/04 09:57 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,72,78,99,94,148,141,177,186,190,195,215,243**;Dec 17, 1997;Build 242 3 LOOP ; -- main loop through "ACT" x-ref 4 I $G(XREF)="AW" D AW Q 5 I $G(FLG)=27 D EXPD^ORQ12 Q 6 K ^TMP("ORGOTIT",$J) 7 AWIN ;Jump in here to add active orders to AW context 8 N TM,TO,IFN,X0,X3,X7,X8,USTS,NOW,ACTOR,X ;195 9 S NOW=+$E($$NOW^XLFDT,1,12),TM=SDATE 10 F S TM=$O(^OR(100,"ACT",PAT,TM)) Q:'TM!(TM>EDATE) S TO=0 F S TO=$O(^OR(100,"ACT",PAT,TM,TO)) Q:'TO I $D(ORGRP(TO)) D 11 . S IFN=0 F S IFN=$O(^OR(100,"ACT",PAT,TM,TO,IFN)) Q:'IFN I ('$D(^TMP("ORGOTIT",$J,IFN))!MULT),$D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D 12 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"ACT",PAT,TM,TO,IFN,ACTOR)) Q:ACTOR<1 I '$D(^TMP("ORGOTIT",$J,IFN,ACTOR)),$D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13!(FLG=1) S X8=^(0),X7=$G(^(7)) D LP1 13 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 14 Q 15 AW ; -- loop through "AW" x-ref 16 K ^TMP("ORGOTIT",$J),^TMP("ORSORT",$J) 17 N TM,TO,IFN,X0,X3,X7,X8,USTS,NOW,ACTOR,X ;195 18 S NOW=+$E($$NOW^XLFDT,1,12),TO=0,SDATE=9999999-SDATE,EDATE=9999999-EDATE 19 F S TO=$O(^OR(100,"AW",PAT,TO)) Q:'TO I $D(ORGRP(TO)) S TM=EDATE F S TM=$O(^OR(100,"AW",PAT,TO,TM)) Q:'TM!(TM>SDATE)!(+TM<EDATE) D 20 . S IFN=0 F S IFN=$O(^OR(100,"AW",PAT,TO,TM,IFN)) Q:'IFN I ('$D(^TMP("ORGOTIT",$J,IFN))!MULT) D 21 .. S ^TMP("ORSORT",$J,9999999-TM,TO,IFN)="" 22 S TM=0 F S TM=$O(^TMP("ORSORT",$J,TM)) Q:'TM S TO=0 F S TO=$O(^TMP("ORSORT",$J,TM,TO)) Q:'TO D 23 . S IFN=0 F S IFN=$O(^TMP("ORSORT",$J,TM,TO,IFN)) Q:'IFN I $D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D 24 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"ACT",PAT,9999999-$P(X0,U,7),TO,IFN,ACTOR)) Q:ACTOR<1 I '$D(^TMP("ORGOTIT",$J,IFN,ACTOR)),$D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13 S X8=^(0),X7=$G(^(7)) D LP1 25 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 26 I +$$GET^XPAR("SYS","OR ORDER SUMMARY CONTEXT",1,"I")=2 S SDATE=9999999-SDATE,EDATE=9999999-EDATE D AWIN 27 K ^TMP("ORSORT",$J),^TMP("ORGOTIT",$J) 28 Q 29 LP1 ; -- main secondary loop 30 N STS ;195 31 N TAG 32 Q:$P(X3,U,8) Q:$P(X3,U,3)=99 S STS=$P(X3,U,3) 33 I '$G(GETKID),$P(X3,U,9),'$P($G(^OR(100,$P(X3,U,9),3)),U,8),FLG'=11 Q 34 I $L($P(X0,U,17)),"^10^11^"[(U_STS_U) S X=$$LAPSED^OREVNTX($P(X0,U,17)) 35 S TAG=$S(FLG=2:"CUR1",FLG=4:"COM1",FLG=5:"EXG1",FLG=7:"PEN1",FLG=8:"UVR1",FLG=9:"UVN1",FLG=10:"UVC1",FLG=12:"FLG1",FLG=13:"VP1",FLG=14:"VPU1",FLG=18:"HLD1",FLG=20:"CHT1",FLG=21:"CHTSUM",FLG=22:"LPS1",FLG=23:"AVT1",1:"ALL1") 36 I TAG="ALL1" S TAG=$S(FLG=3:"DC1",FLG=28:"DC1",1:"ALL1") 37 D @TAG 38 Q 39 ; ** FLG context specific loops: 40 ; 41 ALL1 ; 1 -- secondary pass for All, Recent Orders, Unsigned 42 D GET^ORQ12(IFN,ORLIST,DETAIL,$G(ACTOR)) 43 Q 44 ; 45 CUR ; 2 -- Active/Current 46 N X,X0,X1,X2,X3,X8,%H,YD,%,TM,IFN,ACTOR,NORX,OIEN,OACT 47 I $G(GROUP)=$O(^ORD(100.98,"B","ALL SERVICES",0)),$G(ORWARD),$G(DGPMT)'=1 S NORX=$O(^ORD(100.98,"B","O RX",0)) ;K:X ORGRP(X) ; 177 screen out Outpt Meds if inpt 48 S X2=+$$GET^XPAR("SYS","ORPF ACTIVE ORDERS CONTEXT HRS",1,"I"),X=$H,X=+X*24+($P(X,",",2)/3600),X1=X-X2,X3=X1#24,X1=X1\24,X2=$J(X3*3600,0,0),%H=X1_","_X2 D YMD^%DTC S YD=+(X_%) 49 S TM=SDATE F S TM=$O(^OR(100,"AC",PAT,TM)) Q:TM<1!(TM>EDATE) S IFN=0 F S IFN=$O(^OR(100,"AC",PAT,TM,IFN)) Q:IFN<1 I $D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D 50 . Q:'$D(ORGRP($P(X0,U,11))) S ACTOR=0 51 . F S ACTOR=$O(^OR(100,"AC",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 I $D(^OR(100,IFN,8,ACTOR,0)) S X8=^(0) D 52 .. I "^10^12^"[(U_$P(X8,U,15)_U) K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 53 .. I $P(X8,U,15)=13,$P(X8,U)<YD K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 54 .. I $P(X8,U,15)="",ACTOR'=$P(X3,U,7) K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 55 .. ;AGP waiting for approval change to remove duplicate orders for DC reason 56 .. ;I ACTOR>0,$P($G(^OR(100,IFN,8,ACTOR,0)),U,2)="DC" S OIEN=IFN,OACT=ACTOR 57 .. ;I OIEN=IFN,OACT>ACTOR K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 58 .. D LP1 59 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 60 Q 61 CUR1 ; 2 -- secondary pass for Active/Current 62 N STOP S STOP=$P(X0,U,9) 63 I STS=10 K ^OR(100,"AC",PAT,TM,IFN) Q ;no delayed orders 64 I $P(X8,U,4)=2,$P(X8,U,15)=11 G CURX ;incl all unsig/unrel actions 65 I '$D(YD),"^1^2^7^12^13^14^"[(U_STS_U) K ^OR(100,"AC",PAT,TM,IFN) Q 66 I $D(YD),"^1^2^7^12^13^14^"[(U_STS_U),STOP<YD K ^OR(100,"AC",PAT,TM,IFN) Q 67 I $G(NORX),NORX=$P(X0,U,11) Q ;skip Rx for inpatients 68 CURX D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 69 Q 70 ; 71 DC1 ; 3 -- secondary pass for DC 72 I FLG=28 D GETEIE^ORQ12(IFN,ORLIST,DETAIL,ACTOR) Q 73 I STS=1!(STS=13)!(STS=12) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 74 Q 75 ; 76 COM1 ; 4 -- secondary pass for Completed/Expired 77 N STOP S STOP=$P(X0,U,9) 78 I STS=2!(STS=7)!($L(STOP)&(STOP<NOW)&(STS'=1)&(STS'=13)&(STS'=12)) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 79 Q 80 ; 81 EXG ; 5 -- Expiring 82 N ORNG,ORDT,ORDW,ORHOL,X,Y,%DT,DIC,TMW,NOW ;195 83 F ORNG=1:1 D I ORHOL=0,ORDW=0 Q 84 . S ORDT=$$FMADD^XLFDT(DT,ORNG),ORDW=$S($H-4+ORNG#7>4:1,1:0) 85 . S DIC="^HOLIDAY(",X=$P(ORDT,".") 86 . D ^DIC S ORHOL=$S(+$G(Y)>0:1,1:0) 87 S %DT="",X="T+"_ORNG D ^%DT 88 S TMW=Y_".9999",NOW=+$E($$NOW^XLFDT,1,12) 89 D CUR ;D LOOP 90 Q 91 EXG1 ; 5 -- secondary pass for Expiring 92 N STOP S STOP=$P(X0,U,9) 93 I STS'=1,STS'=2,STS'=7,STS'>9,STOP>NOW,STOP'>TMW D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 94 Q 95 ; 96 ACT ; 6 -- Recent Activity (Order Summary) 97 ;N ORLSIGN S ORLSIGN=$$GET^XPAR("ALL","OR ORDER REVIEW DT","`"_+PAT,"Q") 98 N TM,IFN,X0,X3,ACTOR,X8 99 S TM=SDATE F S TM=$O(^OR(100,"AR",PAT,TM)) Q:TM<1!(TM>EDATE) D 100 . S IFN=0 F S IFN=$O(^OR(100,"AR",PAT,TM,IFN)) Q:IFN<1 S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)) I $D(ORGRP(+$P(X0,U,11))) D 101 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"AR",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 I $D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13 S X8=^(0) D LP1 102 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 103 Q 104 ; 105 PEN1 ; 7 -- secondary pass for Pending 106 I STS=5 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 107 Q 108 ; 109 UVR1 ; 8 -- secondary pass for Unverified 110 ; Include if: unverified, released, inpt, not repl/canc/lapsed 111 I '$P(X8,U,9),'$P(X8,U,11),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 112 Q 113 ; 114 UVN1 ; 9 -- secondary pass for Unverified/Nurse 115 ; Include if: unverified, released, inpt, not repl/canc/lapsed 116 I '$P(X8,U,9),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 117 Q 118 ; 119 UVC1 ; 10 -- secondary pass for Unverified/Clerk 120 ; Include if: unverified, released, inpt, not repl/canc/lapsed 121 I '$P(X8,U,11),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 122 Q 123 ; 124 INPT() ; -- Returns 1 or 0, if inpt order using X0=^OR(100,IFN,0) 125 I ($P(X0,U,12)="I")!($$TYPE^OREVNTX($P(X0,U,17))="D") Q 1 126 ;I $P($G(^SC(+$P(X0,U,10),0)),U,3)="W" Q 1 127 Q 0 128 ; 129 SIG ; 11 -- Unsigned 130 N TM,IFN,X0,X3,ACTOR S TM=SDATE 131 F S TM=$O(^OR(100,"AS",PAT,TM)) Q:TM<1!(TM>EDATE) S IFN=0 F S IFN=$O(^OR(100,"AS",PAT,TM,IFN)) Q:IFN<1 D 132 . S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)) 133 . I X0="" K ^OR(100,"AS",PAT,TM,IFN) Q ;deleted 134 . Q:'$D(ORGRP(+$P(X0,U,11))) ;not a selected DispGrp 135 . S ACTOR=0 F S ACTOR=$O(^OR(100,"AS",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 D 136 .. I $P($G(^OR(100,IFN,8,ACTOR,0)),U,4)'=2 K ^OR(100,"AS",PAT,TM,IFN,ACTOR) Q ;signed or deleted 137 .. D LP1 138 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 139 Q 140 ; 141 FLG1 ; 12 -- secondary pass for Flagged 142 I +$G(^OR(100,IFN,8,ACTOR,3)) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 143 Q 144 ; 145 VP1 ; 13 -- secondary pass for Verbal/Phone 146 N ORNATR S ORNATR=$P(X8,U,12) 147 I ORNATR,"PV"[$P($G(^ORD(100.02,+ORNATR,0)),U,2) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) ;STS'=12 148 Q 149 ; 150 VPU1 ; 14 -- secondary pass for Verbal/Phone Unsigned 151 N ORNATR S ORNATR=$P(X8,U,12) 152 I ORNATR,"PV"[$P($G(^ORD(100.02,+ORNATR,0)),U,2),'$P(X8,U,5),$P(X8,U,4)=2 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) ;STS'=12 153 Q 154 ; 155 HLD1 ; 18 -- secondary pass for On Hold 156 I STS=3 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 157 Q 158 ; 159 NEW ; 19 -- New Orders, plus other unsigned orders by current provider 160 N IFN,ACTOR,TM,X0,X3,X8,ORENT,ORPAR 161 S IFN=0 F S IFN=$O(^TMP("ORNEW",$J,IFN)) Q:IFN'>0 D ;New orders 162 . S ACTOR=0 F S ACTOR=$O(^TMP("ORNEW",$J,IFN,ACTOR)) Q:ACTOR'>0 D 163 .. Q:'$D(^OR(100,IFN,0)) Q:'$D(^(8,ACTOR,0)) ;deleted 164 .. D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 165 G:'$D(^XUSEC("ORES",DUZ)) NW1 ;ck parameter for add'l orders 166 S ORENT="ALL"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"") 167 S ORPAR=$$GET^XPAR(ORENT,"OR UNSIGNED ORDERS ON EXIT") 168 I ORPAR S TM=SDATE F S TM=$O(^OR(100,"AS",PAT,TM)) Q:TM<1!(TM>EDATE) D 169 . S IFN=0 F S IFN=$O(^OR(100,"AS",PAT,TM,IFN)) Q:IFN<1 D 170 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"AS",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 D 171 ... Q:$D(^TMP("ORNEW",$J,IFN,ACTOR)) ;already included 172 ... S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X8=$G(^(8,ACTOR,0)) 173 ... I $S(ORPAR=1&($P(X8,U,3)=DUZ):1,ORPAR=2:1,1:0) D LP1 174 NW1 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 175 Q 176 ; 177 CHT1 ; 20 -- secondary pass for Chart Review 178 ; Include if: unverified, released, inpt, not repl/canc/lapsed 179 I '$P(X8,U,19),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 180 Q 181 ; 182 CHTSUM ; 21 -- secondary pass for Chart copy summary 183 ; Included based on Nature of Order 184 N XP,NAT 185 S XP=+$$GET^XPAR("SYS","OR PRINT ALL ORDERS CHART SUM",1,"I") 186 I XP=2 D Q ;depends on Nature of Order 187 . S NAT=$P($G(^OR(100,IFN,6)),U) 188 . I 'NAT S NAT=$P(X8,U,12) 189 . I NAT,$$CHART^ORX1(NAT) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 190 I XP=0 D Q ;If original printed, print on sum 191 . I X7 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 192 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) ;XP=1 gets All orders 193 Q 194 ; 195 LPS1 ; 22 -- secondary pass for Lapsed 196 I STS=14 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 197 Q 198 ; 199 AVT1 ; 23 -- secondary pass for Active/Pending sts only 200 I (STS=6)!(STS=5) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 201 Q 202 ; 203 QUIT ; -- stop 204 Q 1 ORQ11 ;slc/dcm-Get patient orders in context ;3/31/04 09:57 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,72,78,99,94,148,141,177,186,190,195,215**;Dec 17, 1997 3 LOOP ; -- main loop through "ACT" x-ref 4 I $G(XREF)="AW" D AW Q 5 I $G(FLG)=27 D EXPD^ORQ12 Q 6 K ^TMP("ORGOTIT",$J) 7 AWIN ;Jump in here to add active orders to AW context 8 N TM,TO,IFN,X0,X3,X7,X8,USTS,NOW,ACTOR,X ;195 9 S NOW=+$E($$NOW^XLFDT,1,12),TM=SDATE 10 F S TM=$O(^OR(100,"ACT",PAT,TM)) Q:'TM!(TM>EDATE) S TO=0 F S TO=$O(^OR(100,"ACT",PAT,TM,TO)) Q:'TO I $D(ORGRP(TO)) D 11 . S IFN=0 F S IFN=$O(^OR(100,"ACT",PAT,TM,TO,IFN)) Q:'IFN I ('$D(^TMP("ORGOTIT",$J,IFN))!MULT),$D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D 12 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"ACT",PAT,TM,TO,IFN,ACTOR)) Q:ACTOR<1 I '$D(^TMP("ORGOTIT",$J,IFN,ACTOR)),$D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13!(FLG=1) S X8=^(0),X7=$G(^(7)) D LP1 13 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 14 Q 15 AW ; -- loop through "AW" x-ref 16 K ^TMP("ORGOTIT",$J),^TMP("ORSORT",$J) 17 N TM,TO,IFN,X0,X3,X7,X8,USTS,NOW,ACTOR,X ;195 18 S NOW=+$E($$NOW^XLFDT,1,12),TO=0,SDATE=9999999-SDATE,EDATE=9999999-EDATE 19 F S TO=$O(^OR(100,"AW",PAT,TO)) Q:'TO I $D(ORGRP(TO)) S TM=EDATE F S TM=$O(^OR(100,"AW",PAT,TO,TM)) Q:'TM!(TM>SDATE)!(+TM<EDATE) D 20 . S IFN=0 F S IFN=$O(^OR(100,"AW",PAT,TO,TM,IFN)) Q:'IFN I ('$D(^TMP("ORGOTIT",$J,IFN))!MULT) D 21 .. S ^TMP("ORSORT",$J,9999999-TM,TO,IFN)="" 22 S TM=0 F S TM=$O(^TMP("ORSORT",$J,TM)) Q:'TM S TO=0 F S TO=$O(^TMP("ORSORT",$J,TM,TO)) Q:'TO D 23 . S IFN=0 F S IFN=$O(^TMP("ORSORT",$J,TM,TO,IFN)) Q:'IFN I $D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D 24 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"ACT",PAT,9999999-$P(X0,U,7),TO,IFN,ACTOR)) Q:ACTOR<1 I '$D(^TMP("ORGOTIT",$J,IFN,ACTOR)),$D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13 S X8=^(0),X7=$G(^(7)) D LP1 25 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 26 I +$$GET^XPAR("SYS","OR ORDER SUMMARY CONTEXT",1,"I")=2 S SDATE=9999999-SDATE,EDATE=9999999-EDATE D AWIN 27 K ^TMP("ORSORT",$J),^TMP("ORGOTIT",$J) 28 Q 29 LP1 ; -- main secondary loop 30 N STS ;195 31 N TAG 32 Q:$P(X3,U,8) Q:$P(X3,U,3)=99 S STS=$P(X3,U,3) 33 I '$G(GETKID),$P(X3,U,9),'$P($G(^OR(100,$P(X3,U,9),3)),U,8),FLG'=11 Q 34 I $L($P(X0,U,17)),"^10^11^"[(U_STS_U) S X=$$LAPSED^OREVNTX($P(X0,U,17)) 35 S TAG=$S(FLG=2:"CUR1",FLG=4:"COM1",FLG=5:"EXG1",FLG=7:"PEN1",FLG=8:"UVR1",FLG=9:"UVN1",FLG=10:"UVC1",FLG=12:"FLG1",FLG=13:"VP1",FLG=14:"VPU1",FLG=18:"HLD1",FLG=20:"CHT1",FLG=21:"CHTSUM",FLG=22:"LPS1",FLG=23:"AVT1",1:"ALL1") 36 I TAG="ALL1" S TAG=$S(FLG=3:"DC1",FLG=28:"DC1",1:"ALL1") 37 D @TAG 38 Q 39 ; ** FLG context specific loops: 40 ; 41 ALL1 ; 1 -- secondary pass for All, Recent Orders, Unsigned 42 D GET^ORQ12(IFN,ORLIST,DETAIL,$G(ACTOR)) 43 Q 44 ; 45 CUR ; 2 -- Active/Current 46 N X,X0,X1,X2,X3,%H,YD,%,TM,IFN,ACTOR,OIEN,OACT 47 I $G(GROUP)=$O(^ORD(100.98,"B","ALL SERVICES",0)),$G(ORWARD),$G(DGPMT)'=1 S X=$O(^ORD(100.98,"B","O RX",0)) K:X ORGRP(X) ; 177 screen out Outpt Meds if inpt 48 S X2=+$$GET^XPAR("SYS","ORPF ACTIVE ORDERS CONTEXT HRS",1,"I"),X=$H,X=+X*24+($P(X,",",2)/3600),X1=X-X2,X3=X1#24,X1=X1\24,X2=$J(X3*3600,0,0),%H=X1_","_X2 D YMD^%DTC S YD=+(X_%) 49 S TM=SDATE F S TM=$O(^OR(100,"AC",PAT,TM)) Q:TM<1!(TM>EDATE) S IFN=0 F S IFN=$O(^OR(100,"AC",PAT,TM,IFN)) Q:IFN<1 I $D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D 50 . Q:'$D(ORGRP($P(X0,U,11))) S ACTOR=0 51 . F S ACTOR=$O(^OR(100,"AC",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 I $D(^OR(100,IFN,8,ACTOR,0)) S X=^(0) D 52 .. I "^10^12^"[(U_$P(X,U,15)_U) K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 53 .. I $P(X,U,15)=13,$P(X,U)<YD K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 54 .. I $P(X,U,15)="",ACTOR'=$P(X3,U,7) K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 55 .. ;AGP waiting for approval change to remove duplicate orders for DC reason 56 .. ;I ACTOR>0,$P($G(^OR(100,IFN,8,ACTOR,0)),U,2)="DC" S OIEN=IFN,OACT=ACTOR 57 .. ;I OIEN=IFN,OACT>ACTOR K ^OR(100,"AC",PAT,TM,IFN,ACTOR) Q 58 .. D LP1 59 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 60 Q 61 CUR1 ; 2 -- secondary pass for Active/Current 62 N STOP S STOP=$P(X0,U,9) 63 I STS=10 K ^OR(100,"AC",PAT,TM,IFN) Q ;no delayed orders 64 I '$D(YD),"^1^2^7^12^13^14^"[(U_STS_U) K ^OR(100,"AC",PAT,TM,IFN) Q 65 I $D(YD),"^1^2^7^12^13^14^"[(U_STS_U),STOP<YD K ^OR(100,"AC",PAT,TM,IFN) Q 66 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 67 Q 68 ; 69 DC1 ; 3 -- secondary pass for DC 70 I FLG=28 D GETEIE^ORQ12(IFN,ORLIST,DETAIL,ACTOR) Q 71 I STS=1!(STS=13)!(STS=12) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 72 Q 73 ; 74 COM1 ; 4 -- secondary pass for Completed/Expired 75 N STOP S STOP=$P(X0,U,9) 76 I STS=2!(STS=7)!($L(STOP)&(STOP<NOW)&(STS'=1)&(STS'=13)&(STS'=12)) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 77 Q 78 ; 79 EXG ; 5 -- Expiring 80 N ORNG,ORDT,ORDW,ORHOL,X,Y,%DT,DIC,TMW,NOW ;195 81 F ORNG=1:1 D I ORHOL=0,ORDW=0 Q 82 . S ORDT=$$FMADD^XLFDT(DT,ORNG),ORDW=$S($H-4+ORNG#7>4:1,1:0) 83 . S DIC="^HOLIDAY(",X=$P(ORDT,".") 84 . D ^DIC S ORHOL=$S(+$G(Y)>0:1,1:0) 85 S %DT="",X="T+"_ORNG D ^%DT 86 S TMW=Y_".9999",NOW=+$E($$NOW^XLFDT,1,12) 87 D CUR ;D LOOP 88 Q 89 EXG1 ; 5 -- secondary pass for Expiring 90 N STOP S STOP=$P(X0,U,9) 91 I STS'=1,STS'=2,STS'=7,STS'>9,STOP>NOW,STOP'>TMW D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 92 Q 93 ; 94 ACT ; 6 -- Recent Activity (Order Summary) 95 ;N ORLSIGN S ORLSIGN=$$GET^XPAR("ALL","OR ORDER REVIEW DT","`"_+PAT,"Q") 96 N TM,IFN,X0,X3,ACTOR,X8 97 S TM=SDATE F S TM=$O(^OR(100,"AR",PAT,TM)) Q:TM<1!(TM>EDATE) D 98 . S IFN=0 F S IFN=$O(^OR(100,"AR",PAT,TM,IFN)) Q:IFN<1 S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)) I $D(ORGRP(+$P(X0,U,11))) D 99 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"AR",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 I $D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13 S X8=^(0) D LP1 100 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 101 Q 102 ; 103 PEN1 ; 7 -- secondary pass for Pending 104 I STS=5 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 105 Q 106 ; 107 UVR1 ; 8 -- secondary pass for Unverified 108 ; Include if: unverified, released, inpt, not repl/canc/lapsed 109 I '$P(X8,U,9),'$P(X8,U,11),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 110 Q 111 ; 112 UVN1 ; 9 -- secondary pass for Unverified/Nurse 113 ; Include if: unverified, released, inpt, not repl/canc/lapsed 114 I '$P(X8,U,9),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 115 Q 116 ; 117 UVC1 ; 10 -- secondary pass for Unverified/Clerk 118 ; Include if: unverified, released, inpt, not repl/canc/lapsed 119 I '$P(X8,U,11),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 120 Q 121 ; 122 INPT() ; -- Returns 1 or 0, if inpt order using X0=^OR(100,IFN,0) 123 I ($P(X0,U,12)="I")!($P(X0,U,17)="D") Q 1 124 I $P($G(^SC(+$P(X0,U,10),0)),U,3)="W" Q 1 125 Q 0 126 ; 127 SIG ; 11 -- Unsigned 128 N TM,IFN,X0,X3,ACTOR S TM=SDATE 129 F S TM=$O(^OR(100,"AS",PAT,TM)) Q:TM<1!(TM>EDATE) S IFN=0 F S IFN=$O(^OR(100,"AS",PAT,TM,IFN)) Q:IFN<1 D 130 . S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)) 131 . I X0="" K ^OR(100,"AS",PAT,TM,IFN) Q ;deleted 132 . Q:'$D(ORGRP(+$P(X0,U,11))) ;not a selected DispGrp 133 . S ACTOR=0 F S ACTOR=$O(^OR(100,"AS",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 D 134 .. I $P($G(^OR(100,IFN,8,ACTOR,0)),U,4)'=2 K ^OR(100,"AS",PAT,TM,IFN,ACTOR) Q ;signed or deleted 135 .. D LP1 136 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 137 Q 138 ; 139 FLG1 ; 12 -- secondary pass for Flagged 140 I +$G(^OR(100,IFN,8,ACTOR,3)) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 141 Q 142 ; 143 VP1 ; 13 -- secondary pass for Verbal/Phone 144 N ORNATR S ORNATR=$P(X8,U,12) 145 I ORNATR,"PV"[$P($G(^ORD(100.02,+ORNATR,0)),U,2) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) ;STS'=12 146 Q 147 ; 148 VPU1 ; 14 -- secondary pass for Verbal/Phone Unsigned 149 N ORNATR S ORNATR=$P(X8,U,12) 150 I ORNATR,"PV"[$P($G(^ORD(100.02,+ORNATR,0)),U,2),'$P(X8,U,5),$P(X8,U,4)=2 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) ;STS'=12 151 Q 152 ; 153 HLD1 ; 18 -- secondary pass for On Hold 154 I STS=3 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 155 Q 156 ; 157 NEW ; 19 -- New Orders, plus other unsigned orders by current provider 158 N IFN,ACTOR,TM,X0,X3,X8,ORENT,ORPAR 159 S IFN=0 F S IFN=$O(^TMP("ORNEW",$J,IFN)) Q:IFN'>0 D ;New orders 160 . S ACTOR=0 F S ACTOR=$O(^TMP("ORNEW",$J,IFN,ACTOR)) Q:ACTOR'>0 D 161 .. Q:'$D(^OR(100,IFN,0)) Q:'$D(^(8,ACTOR,0)) ;deleted 162 .. D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 163 G:'$D(^XUSEC("ORES",DUZ)) NW1 ;ck parameter for add'l orders 164 S ORENT="ALL"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"") 165 S ORPAR=$$GET^XPAR(ORENT,"OR UNSIGNED ORDERS ON EXIT") 166 I ORPAR S TM=SDATE F S TM=$O(^OR(100,"AS",PAT,TM)) Q:TM<1!(TM>EDATE) D 167 . S IFN=0 F S IFN=$O(^OR(100,"AS",PAT,TM,IFN)) Q:IFN<1 D 168 .. S ACTOR=0 F S ACTOR=$O(^OR(100,"AS",PAT,TM,IFN,ACTOR)) Q:ACTOR<1 D 169 ... Q:$D(^TMP("ORNEW",$J,IFN,ACTOR)) ;already included 170 ... S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X8=$G(^(8,ACTOR,0)) 171 ... I $S(ORPAR=1&($P(X8,U,3)=DUZ):1,ORPAR=2:1,1:0) D LP1 172 NW1 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST 173 Q 174 ; 175 CHT1 ; 20 -- secondary pass for Chart Review 176 ; Include if: unverified, released, inpt, not repl/canc/lapsed 177 I '$P(X8,U,19),$P(X8,U,15)="",$$INPT,"^12^13^14^"'[(U_STS_U) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 178 Q 179 ; 180 CHTSUM ; 21 -- secondary pass for Chart copy summary 181 ; Included based on Nature of Order 182 N XP,NAT 183 S XP=+$$GET^XPAR("SYS","OR PRINT ALL ORDERS CHART SUM",1,"I") 184 I XP=2 D Q ;depends on Nature of Order 185 . S NAT=$P($G(^OR(100,IFN,6)),U) 186 . I 'NAT S NAT=$P(X8,U,12) 187 . I NAT,$$CHART^ORX1(NAT) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 188 I XP=0 D Q ;If original printed, print on sum 189 . I X7 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 190 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) ;XP=1 gets All orders 191 Q 192 ; 193 LPS1 ; 22 -- secondary pass for Lapsed 194 I STS=14 D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 195 Q 196 ; 197 AVT1 ; 23 -- secondary pass for Active/Pending sts only 198 I (STS=6)!(STS=5) D GET^ORQ12(IFN,ORLIST,DETAIL,ACTOR) 199 Q 200 ; 201 QUIT ; -- stop 202 Q
Note:
See TracChangeset
for help on using the changeset viewer.
