- 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/ORWDXA.m
r613 r623 1 ORWDXA ; SLC/KCM/JLI - Utilites for Order Actions; 10/07/2007 ; 2/7/08 11:48am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,141,149,187,213,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 VALID(VAL,ORID,ACTION,ORNP,ORWNAT) ; Return error message if not valid action for order 5 N ORACT,ORVP,ORVER,ORIFN,PRTID S VAL="",PRTID=0 6 I +ORID=0 S VAL="This order has been deleted." Q 7 I '$D(^OR(100,+ORID,0)) S VAL="This order has been deleted!" Q 8 I ACTION="XFR",'$L($T(XFR^ORCACT01)) S ACTION="RW" ; for pre-POE 9 N ORNSS S ORNSS=1 10 I (ACTION="RN") D VALSCH^ORWNSS(.ORNSS,ORID) 11 I ORNSS=0 S VAL="This order contains an invalid administration schedule." Q 12 I (ACTION="RN") D ISVALIV^ORWDPS33(.VAL,ORID,ACTION) I $L(VAL)>0 Q 13 S ORIFN=ORID,ORVP=$P(^OR(100,+ORID,0),U,2) ; ORCACT0 expects defined 14 I (ACTION="RN") D Q:$L(VAL) ; ** There's got to be a better way! 15 . N DLG S DLG=$P(^OR(100,+ORID,0),U,5) Q:DLG'[";ORD(101.41," 16 . I $G(^ORD(101.41,+DLG,3))'["PROVIDER^ORCDPSIV" Q 17 . D AUTH^ORWDPS32(.VAL,ORNP) 18 . I VAL S VAL=$P(VAL,U,2) 19 . E S VAL="" 20 S ORVER=$S(ACTION="CR":"R",$D(^XUSEC("ORELSE",DUZ)):"N",$D(^XUSEC("OREMAS",DUZ)):"C",1:"^") 21 I ACTION="CR" S ACTION="VR" 22 I (ACTION="ES")!(ACTION="OC")!(ACTION="RS") S ORACT=ACTION ; why not defined??? 23 I (ACTION="VR"),'($D(^XUSEC("ORELSE",DUZ))!$D(^XUSEC("OREMAS",DUZ))) D Q 24 . S VAL="You are not authorized to verify these orders." 25 I $L(VAL) Q 26 N OIIEN,ISIV,IVOD 27 S (ISIV,OIIEN,IVOD)=0 28 I (ACTION="RW")!(ACTION="XX")!(ACTION="XFR") D Q:$L(VAL) 29 . S ISIV=$P(^OR(100,+ORID,0),U,11) 30 . I ISIV,($P(^ORD(100.98,ISIV,0),U,3)="IV RX") S IVOD=1 31 . D:'IVOD GTORITM^ORWDXR(.OIIEN,+ORID) 32 . D:OIIEN ISACTOI(.VAL,OIIEN) I $L(VAL)>0 Q 33 . N DLG,FRM 34 . S DLG=$P(^OR(100,+ORID,0),U,5),FRM=0 35 . I $P(DLG,";",2)'="ORD(101.41," S DLG=0 36 . I DLG D FORMID^ORWDXM(.FRM,+DLG) 37 . I '(DLG&FRM) D 38 . . S VAL="Copy & Change are not implemented for this order that predates CPRS." 39 N OREBUILD ; sometimes left defined by $$VALID 40 ;I (ACTION="RW")!(ACTION="XFR")!(ACTION="RN") D ISVALIV^ORWDPS33(.VAL,ORID,ACTION) I $L(VAL)>0 Q 41 I $$VALID^ORCACT0(ORID,ACTION,.VAL,$G(ORWNAT)) S VAL="" ; VAL=error 42 Q 43 ; 44 HOLD(REC,ORID,ORNP) ; Place an order on hold 45 N ACTDA 46 S ACTDA=$$ACTION^ORCSAVE("HD",+ORID,ORNP) 47 D GETBYIFN^ORWORR(.REC,+ORID_";"_ACTDA) 48 Q 49 UNHOLD(REC,ORID,ORNP) ; Release an order from hold 50 N ACTDA 51 S ACTDA=$$ACTION^ORCSAVE("RL",+ORID,ORNP) 52 D GETBYIFN^ORWORR(.REC,+ORID_";"_ACTDA) 53 Q 54 DC(REC,ORID,ORNP,ORL,REASON,DCORIG,ISNEWORD) ; Discontinue/Cancel/Delete an order 55 N NATURE,CREATE,PRINT,STATUS,ACTDA,SIGSTS 56 N X3,X8,CURRACT 57 Q:'+ORID 58 I $G(DCORIG)="" S DCORIG=0 59 S CURRACT=0 60 S ORL(2)=ORL_";SC(",ORL=ORL(2),NATURE="" 61 I REASON S NATURE=$P(^ORD(100.02,$P(^ORD(100.03,REASON,0),U,7),0),U,2) 62 S:NATURE="" NATURE="W" ; S:ORNP=DUZ NATURE="E" 63 ;change the way create work to support forcing signature for all DC 64 ;reasons 65 S CREATE=1,PRINT=$$PRINT^ORCACT2(NATURE) 66 ;S CREATE=$$CREATE^ORX1(NATURE) 67 S X3=$G(^OR(100,+ORID,3)) 68 S CURRACT=$P(X3,U,7) S:CURRACT<1 CURRACT=+$O(^OR(100,+ORID,8,"?"),-1) 69 I '$D(^OR(100,+ORID,8,+$P(ORID,";",2),0)) D 70 . S X8=$G(^OR(100,+ORID,8,CURRACT,0)) 71 . S SIGSTS=$P(X8,U,4) 72 . S $P(ORID,";",2)=CURRACT 73 E D 74 . S X8=^OR(100,+ORID,8,+$P(ORID,";",2),0) 75 . S SIGSTS=$P(X8,U,4) 76 I '$D(SIGSTS) S SIGSTS=1 77 S STATUS=$P($G(^OR(100,+ORID,8,+$P(ORID,";",2),0)),U,15) 78 I (STATUS=10)!(STATUS=11) D Q ; delete/cancel unreleased order 79 . N RPLORD 80 . S RPLORD=$P($G(^OR(100,+ORID,3)),U,5) ; replaced order 81 . D GETBYIFN^ORWORR(.REC,ORID) 82 . I STATUS=10,($P(X8,U,4)'=2) D ; CANCEL signed, delayed, unreleased 83 . . ; taken from CLRDLY^ORCACT2 84 . . I REASON D SET^ORCACT2(+ORID,NATURE,REASON,,DCORIG) 85 . . I 'REASON D SET^ORCACT2(+ORID,"M","","Delayed Order Cancelled",DCORIG) 86 . . D STATUS^ORCSAVE2(+ORID,13) S $P(^OR(100,+ORID,8,1,0),U,15)=13 87 . E D ; CANCEL OR DELETE unsigned, unreleased 88 . . I $P(X8,U,2)="DC" K ^OR(100,+ORID,6) 89 . . ; delete fwd ptr to order about to be deleted 90 . . I RPLORD,$P(X8,U,2)="NW" S $P(^OR(100,RPLORD,3),U,6)="" 91 . . ; delete ptr to order in Patient Event file #100.2 92 . . N EVT S EVT=$P($G(^OR(100,+ORID,0)),U,17) I EVT,EVT=+$O(^ORE(100.2,"AO",+ORID,0)) S $P(^ORE(100.2,EVT,0),U,4)="" K ^ORE(100.2,"AO",+ORID,EVT) 93 . . I $G(ISNEWORD) D DELETE^ORCSAVE2(ORID) 94 . . I '$G(ISNEWORD) D CANCEL^ORCSAVE2(ORID) 95 . I RPLORD,'(SIGSTS=1) S ORID=RPLORD ; for Renews & Changes, show replaced order 96 . I '$D(^OR(100,+ORID)) D 97 . . S $P(REC(1),U)="~0",REC(2)="tDELETED: "_$E(REC(2),2,245) 98 . E D 99 . . K REC 100 . . D GETBYIFN^ORWORR(.REC,+ORID_";"_$P($G(^OR(100,+ORID,3)),U,7)) 101 . S $P(REC(1),U,14)=2 ; DCType = deletion 102 S ACTDA=$$ACTION^ORCSAVE("DC",+ORID,ORNP) 103 D SET^ORCACT2(+ORID,NATURE,REASON,,DCORIG) 104 D GETBYIFN^ORWORR(.REC,+ORID_";"_ACTDA) 105 S $P(REC(1),U,14)=$S(CREATE:1,1:3) ;DCType - 1=NewOrder, 3=NewStatus 106 N PKG 107 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 108 S PKG=$$NMSP^ORCD(PKG) 109 I REASON=16&(PKG="PS") D 110 . N XMB 111 . S XMB="OR DRUG ORDER CANCELLED" 112 . S XMB(1)=$P($G(REC(2)),"tDiscontinue",2),XMB(4)=$P($G(^VA(200,DUZ,0)),U) 113 . S XMB(2)=+ORID 114 . S XMB(3)=+$P($G(^OR(100,+ORID,0)),U,2) 115 . S XMB(3)=$P($G(^DPT(XMB(3),0)),U) 116 . D ^XMB 117 Q 118 DCREQIEN(VAL) ; Return the IEN for Requesting Physician Cancelled reason 119 S VAL=$O(^ORD(100.03,"S","REQ",0)) 120 Q 121 COMPLETE(REC,ORID,ESCODE) ; Complete an order (generic orders) 122 ;N X S X=+$E($$NOW^XLFDT,1,12) 123 ;D DATES^ORCSAVE2(+ORID,,X) 124 ;D STATUS^ORCSAVE2(+ORID,2) 125 ; validate ESCode 126 D COMP^ORCSAVE2(ORID) 127 D GETBYIFN^ORWORR(.REC,ORID) 128 Q 129 VERIFY(REC,ORID,ESCODE,ORVER) ; Verify an order 130 ; validate ESCode 131 S ORVER=$G(ORVER,$S($D(^XUSEC("ORELSE",DUZ)):"N",$D(^XUSEC("OREMAS",DUZ)):"C",1:U)) 132 I ORVER'=U D 133 . N ORIFN,ORES,ORI 134 . ; to match 56, need to VERIFY any replaced orders: 135 . S ORIFN=ORID,ORES(ORIFN)="" D REPLCD^ORCACT1 136 . S ORI="" F S ORI=$O(ORES(ORI)) Q:ORI="" D EN^ORCSEND(ORI,"VR","",""),UNLK1^ORX2(+ORI):ORI'=ORID ;ORID locked prior 137 D GETBYIFN^ORWORR(.REC,ORID) 138 Q 139 ALERT(DUMMY,ORID,ORDUZ) ;send alert to user (ORDUZ) when order (ORID) resulted 140 ;if no user passed from GUI, use ordering provider: 141 I $G(ORDUZ)<1 S ORDUZ=+$$ORDERER^ORQOR2(+ORID) 142 I $L($G(ORDUZ))<1 S ORDUZ=DUZ 143 S DUMMY=1,$P(^OR(100,+ORID,3),U,10)=ORDUZ 144 Q 145 FLAG(REC,ORIFN,OREASON,ORNP) ; Flag an order 146 N ORB,ORVP,DA,ORPS 147 D BULLETIN 148 S DA=$P(ORIFN,";",2),ORVP=+$P(^OR(100,+ORIFN,0),U,2) 149 K ^OR(100,+ORIFN,8,DA,3) S ^(3)="1^"_$G(XMZ)_U_+$E($$NOW^XLFDT,1,12)_U_DUZ_U_OREASON_$S($G(ORNP):"^^^^"_+ORNP,1:"") 150 D KILL^XM,MSG^ORCFLAG(ORIFN) 151 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; Last Activity 152 I +$G(ORNP)<1 S ORNP=+$P($G(^OR(100,+ORIFN,8,DA,0)),U,3) 153 S ORB=+ORVP_U_+ORIFN_U_ORNP_"^1" D EN^OCXOERR(ORB) ; notification 154 D GETBYIFN^ORWORR(.REC,ORIFN) 155 Q 156 BULLETIN ; Send flagged order bulletin (USED BY FLAG) 157 N OR0,OR3,ORDTXT,XMB,XMY,XMDUZ,ORENT,BULL,ORSRV,ORUSR 158 S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)) 159 ;CLA - 3/21/96: 160 S ORUSR=+$P(OR0,U,4) 161 S ORSRV=$G(^VA(200,ORUSR,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) 162 S ORENT="USR.`"_ORUSR_"^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG" 163 S BULL=$$GET^XPAR(ORENT,"ORB FLAGGED ORDERS BULLETIN",1,"Q") 164 Q:$G(BULL)'="Y" ;quit if parameter value is not 'Y'es 165 ; 166 S XMB="OR FLAGGED ORDER",XMDUZ=DUZ,XMY(+$P(OR0,U,4))="" 167 S XMB(1)=$P(^DPT(+$P(OR0,U,2),0),U),XMB(2)=$P(^(0),U,9),XMB(3)="" ;sb AGE 168 S XMB(4)=$$FMTE^XLFDT($P(OR0,U,7)) 169 D TEXT^ORQ12(.ORDTXT,+ORIFN,80) 170 S XMB(5)=$G(ORDTXT(1)),XMB(6)=$G(ORDTXT(2)),XMB(7)=$G(ORDTXT(3)) 171 S XMB(8)=$$FMTE^XLFDT($P(OR0,U,8)),XMB(9)=$$FMTE^XLFDT($P(OR0,U,9)),XMB(10)=OREASON 172 S XMB(11)=$P($G(^ORD(100.01,+$P(OR3,U,3),0)),U) 173 D EN^XMB 174 Q 175 UNFLAG(REC,ORIFN,OREASON) ; Unflag an order 176 N DA,ORB,ORNP,ORVP,ORPS 177 S DA=$P(ORIFN,";",2),ORVP=+$P(^OR(100,+ORIFN,0),U,2) 178 S $P(^OR(100,+ORIFN,8,DA,3),U)=0,$P(^(3),U,6,8)=+$E($$NOW^XLFDT,1,12)_U_DUZ_U_OREASON D MSG^ORCFLAG(ORIFN) 179 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; Last Activity 180 S ORNP=+$P($G(^OR(100,+ORIFN,8,DA,0)),U,3) 181 S ORB=+ORVP_U_+ORIFN_U_ORNP_"^0" D EN^OCXOERR(ORB) ; notification 182 D GETBYIFN^ORWORR(.REC,ORIFN) 183 Q 184 FLAGTXT(LST,ORID) ; Return flag reason 185 N FLAG 186 S FLAG=$G(^OR(100,+ORID,8,$P(ORID,";",2),3)) 187 S LST(1)="FLAGGED: "_$$FMTE^XLFDT($P(FLAG,U,3))_" by "_$P($G(^VA(200,+$P(FLAG,U,4),0)),U) 188 S LST(2)=$P(FLAG,U,5) ; reason 189 Q 190 WCGET(LST,ORID) ; Return ward comments 191 N I,ORIFN,ACT S ORIFN=+ORID,ACT=+$P(ORID,";",2) 192 S I=0 F S I=$O(^OR(100,ORIFN,8,ACT,5,I)) Q:'I S LST(I)=$G(^(I,0)) 193 Q 194 WCPUT(ERR,ORID,WCLST) ; Set ward comments for order 195 N DIERR,ERRLST,ORIFN,ACT S ORIFN=+ORID,ACT=+$P(ORID,";",2) 196 D WP^DIE(100.008,ACT_","_ORIFN_",",50,"","WCLST","ERRLST") 197 S ERR="" I $D(DIERR) S ERR="An error occurred while saving comments." 198 Q 199 OFCPLX(ORY,ORID,PRTORDER) ;Check if ORID is an child of the PRTORDER 200 N NUMCHDS,NOWID,NOWVAL,X3,ORDA,ISNOW 201 Q:'$D(^OR(100,+ORID,0)) 202 S ISNOW=0 203 D ISNOW^ORWDXR(.ISNOW,+ORID) 204 Q:ISNOW 205 N PKG 206 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 207 S PKG=$$NMSP^ORCD(PKG) 208 I PKG'="PS" Q 209 I $L($G(^OR(100,+ORID,3))),('$L($P(^(3),U,9))) Q 210 S (NUMCHDS,NOWID,NOWVAL,X3,ORDA)=0 211 S PRTORDER=+$P(^(3),U,9) 212 S X3=$G(^OR(100,PRTORDER,3)),ORDA=$P(X3,U,7) 213 S PRTORDER=PRTORDER_";"_ORDA 214 S NUMCHDS=$P($G(^OR(100,+PRTORDER,2,0)),U,4) 215 I NUMCHDS>2 S ORY="COMPLEX-PSI"_U_PRTORDER 216 S:$D(^OR(100,+PRTORDER,4.5,"ID","NOW")) NOWID=$O(^("NOW",0)) 217 S:NOWID NOWVAL=$G(^OR(100,+PRTORDER,4.5,NOWID,1)) 218 I NOWVAL=1 Q 219 E S ORY="COMPLEX-PSI"_U_PRTORDER 220 Q 221 ISACTOI(ORY,OI) ;If it's an active orderable item 222 I $G(^ORD(101.43,+OI,.1)),^(.1)'>$$NOW^XLFDT D 223 . S ORY=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore." 224 Q 1 ORWDXA ; SLC/KCM/JLI - Utilites for Order Actions; 2/10/03 9:13Am [6/7/05 2:09pm] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,141,149,187,213,195,215**;Dec 17, 1997 3 ; 4 VALID(VAL,ORID,ACTION,ORNP,ORWNAT) ; Return error message if not valid action for order 5 N ORACT,ORVP,ORVER,ORIFN,PRTID S VAL="",PRTID=0 6 I +ORID=0 S VAL="This order has been deleted." Q 7 I '$D(^OR(100,+ORID,0)) S VAL="This order has been deleted!" Q 8 I ACTION="XFR",'$L($T(XFR^ORCACT01)) S ACTION="RW" ; for pre-POE 9 N ORNSS S ORNSS=1 10 I (ACTION="RN") D VALSCH^ORWNSS(.ORNSS,ORID) 11 I ORNSS=0 S VAL="This order contains an invalid administration schedule." Q 12 S ORIFN=ORID,ORVP=$P(^OR(100,+ORID,0),U,2) ; ORCACT0 expects defined 13 I (ACTION="RN") D Q:$L(VAL) ; ** There's got to be a better way! 14 . N DLG S DLG=$P(^OR(100,+ORID,0),U,5) Q:DLG'[";ORD(101.41," 15 . I $G(^ORD(101.41,+DLG,3))'["PROVIDER^ORCDPSIV" Q 16 . D AUTH^ORWDPS32(.VAL,ORNP) 17 . I VAL S VAL=$P(VAL,U,2) 18 . E S VAL="" 19 S ORVER=$S(ACTION="CR":"R",$D(^XUSEC("ORELSE",DUZ)):"N",$D(^XUSEC("OREMAS",DUZ)):"C",1:"^") 20 I ACTION="CR" S ACTION="VR" 21 I (ACTION="ES")!(ACTION="OC")!(ACTION="RS") S ORACT=ACTION ; why not defined??? 22 I (ACTION="VR"),'($D(^XUSEC("ORELSE",DUZ))!$D(^XUSEC("OREMAS",DUZ))) D Q 23 . S VAL="You are not authorized to verify these orders." 24 I $L(VAL) Q 25 N OIIEN,ISIV,IVOD 26 S (ISIV,OIIEN,IVOD)=0 27 I (ACTION="RW")!(ACTION="XX")!(ACTION="XFR") D Q:$L(VAL) 28 . S ISIV=$P(^OR(100,+ORID,0),U,11) 29 . I ISIV,($P(^ORD(100.98,ISIV,0),U,3)="IV RX") S IVOD=1 30 . D:'IVOD GTORITM^ORWDXR(.OIIEN,+ORID) 31 . D:OIIEN ISACTOI(.VAL,OIIEN) I $L(VAL)>0 Q 32 . N DLG,FRM 33 . S DLG=$P(^OR(100,+ORID,0),U,5),FRM=0 34 . I $P(DLG,";",2)'="ORD(101.41," S DLG=0 35 . I DLG D FORMID^ORWDXM(.FRM,+DLG) 36 . I '(DLG&FRM) D 37 . . S VAL="Copy & Change are not implemented for this order that predates CPRS." 38 N OREBUILD ; sometimes left defined by $$VALID 39 I $$VALID^ORCACT0(ORID,ACTION,.VAL,$G(ORWNAT)) S VAL="" ; VAL=error 40 Q 41 HOLD(REC,ORID,ORNP) ; Place an order on hold 42 N ACTDA 43 S ACTDA=$$ACTION^ORCSAVE("HD",+ORID,ORNP) 44 D GETBYIFN^ORWORR(.REC,+ORID_";"_ACTDA) 45 Q 46 UNHOLD(REC,ORID,ORNP) ; Release an order from hold 47 N ACTDA 48 S ACTDA=$$ACTION^ORCSAVE("RL",+ORID,ORNP) 49 D GETBYIFN^ORWORR(.REC,+ORID_";"_ACTDA) 50 Q 51 DC(REC,ORID,ORNP,ORL,REASON) ; Discontinue/Cancel/Delete an order 52 N NATURE,CREATE,PRINT,STATUS,ACTDA,SIGSTS 53 N X3,X8,CURRACT 54 Q:'+ORID 55 S CURRACT=0 56 S ORL(2)=ORL_";SC(",ORL=ORL(2),NATURE="" 57 I REASON S NATURE=$P(^ORD(100.02,$P(^ORD(100.03,REASON,0),U,7),0),U,2) 58 S:NATURE="" NATURE="W" ; S:ORNP=DUZ NATURE="E" 59 ;change the way create work to support forcing signature for all DC 60 ;reasons 61 S CREATE=1,PRINT=$$PRINT^ORCACT2(NATURE) 62 ;S CREATE=$$CREATE^ORX1(NATURE) 63 S X3=$G(^OR(100,+ORID,3)) 64 S CURRACT=$P(X3,U,7) S:CURRACT<1 CURRACT=+$O(^OR(100,+ORID,8,"?"),-1) 65 I '$D(^OR(100,+ORID,8,+$P(ORID,";",2),0)) D 66 . S X8=$G(^OR(100,+ORID,8,CURRACT,0)) 67 . S SIGSTS=$P(X8,U,4) 68 . S $P(ORID,";",2)=CURRACT 69 E D 70 . S X8=^OR(100,+ORID,8,+$P(ORID,";",2),0) 71 . S SIGSTS=$P(X8,U,4) 72 I '$D(SIGSTS) S SIGSTS=1 73 S STATUS=$P($G(^OR(100,+ORID,8,+$P(ORID,";",2),0)),U,15) 74 I (STATUS=10)!(STATUS=11) D Q ; delete/cancel unreleased order 75 . N RPLORD 76 . S RPLORD=$P($G(^OR(100,+ORID,3)),U,5) ; replaced order 77 . D GETBYIFN^ORWORR(.REC,ORID) 78 . I STATUS=10,($P(X8,U,4)'=2) D ; CANCEL signed, delayed, unreleased 79 . . ; taken from CLRDLY^ORCACT2 80 . . I REASON D SET^ORCACT2(+ORID,NATURE,REASON) 81 . . I 'REASON D SET^ORCACT2(+ORID,"M","","Delayed Order Cancelled") 82 . . D STATUS^ORCSAVE2(+ORID,13) S $P(^OR(100,+ORID,8,1,0),U,15)=13 83 . E D ; DELETE unsigned, unreleased 84 . . I $P(X8,U,2)="DC" K ^OR(100,+ORID,6) 85 . . ; delete fwd ptr to order about to be deleted 86 . . I RPLORD,$P(X8,U,2)="NW" S $P(^OR(100,RPLORD,3),U,6)="" 87 . . ; delete ptr to order in Patient Event file #100.2 88 . . N EVT S EVT=$P($G(^OR(100,+ORID,0)),U,17) I EVT,EVT=+$O(^ORE(100.2,"AO",+ORID,0)) S $P(^ORE(100.2,EVT,0),U,4)="" K ^ORE(100.2,"AO",+ORID,EVT) 89 . . D DELETE^ORCSAVE2(ORID) 90 . I RPLORD,'(SIGSTS=1) S ORID=RPLORD ; for Renews & Changes, show replaced order 91 . I '$D(^OR(100,+ORID)) D 92 . . S $P(REC(1),U)="~0",REC(2)="tDELETED: "_$E(REC(2),2,245) 93 . E D 94 . . K REC 95 . . D GETBYIFN^ORWORR(.REC,+ORID_";"_$P($G(^OR(100,+ORID,3)),U,7)) 96 . S $P(REC(1),U,14)=2 ; DCType = deletion 97 S ACTDA=$$ACTION^ORCSAVE("DC",+ORID,ORNP) 98 D SET^ORCACT2(+ORID,NATURE,REASON) 99 D GETBYIFN^ORWORR(.REC,+ORID_";"_ACTDA) 100 S $P(REC(1),U,14)=$S(CREATE:1,1:3) ;DCType - 1=NewOrder, 3=NewStatus 101 N PKG 102 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 103 S PKG=$$NMSP^ORCD(PKG) 104 I REASON=16&(PKG="PS") D 105 . N XMB 106 . S XMB="OR DRUG ORDER CANCELLED" 107 . S XMB(1)=$P($G(REC(2)),"tDiscontinue",2),XMB(4)=$P($G(^VA(200,DUZ,0)),U) 108 . S XMB(2)=+ORID 109 . S XMB(3)=+$P($G(^OR(100,+ORID,0)),U,2) 110 . S XMB(3)=$P($G(^DPT(XMB(3),0)),U) 111 . D ^XMB 112 Q 113 DCREASON(LST) ; Return a list of DC reasons 114 N IEN,ILST,X 115 S ILST=1,LST(ILST)="~DCReason" 116 S IEN=0 F S IEN=$O(^ORD(100.03,IEN)) Q:'IEN S X=^(IEN,0) D 117 . I $P(X,U,4) Q ; inactive 118 . I $P(X,U,5)'=+$O(^DIC(9.4,"C","OR",0)) Q ; not OR pkg 119 . I $P(X,U,7)=+$O(^ORD(100.02,"C","A",0)) Q ; nature=auto 120 . S ILST=ILST+1,LST(ILST)="i"_IEN_U_$P(X,U) 121 S IEN=$O(^ORD(100.03,"C","ORREQ",0)) 122 I IEN S ILST=ILST+1,LST(ILST)="d"_IEN_U_$P(^ORD(100.03,IEN,0),U) 123 Q 124 DCREQIEN(VAL) ; Return the IEN for Requesting Physician Cancelled reason 125 S VAL=$O(^ORD(100.03,"S","REQ",0)) 126 Q 127 COMPLETE(REC,ORID,ESCODE) ; Complete an order (generic orders) 128 ;N X S X=+$E($$NOW^XLFDT,1,12) 129 ;D DATES^ORCSAVE2(+ORID,,X) 130 ;D STATUS^ORCSAVE2(+ORID,2) 131 ; validate ESCode 132 D COMP^ORCSAVE2(ORID) 133 D GETBYIFN^ORWORR(.REC,ORID) 134 Q 135 VERIFY(REC,ORID,ESCODE,ORVER) ; Verify an order 136 ; validate ESCode 137 S ORVER=$G(ORVER,$S($D(^XUSEC("ORELSE",DUZ)):"N",$D(^XUSEC("OREMAS",DUZ)):"C",1:U)) 138 I ORVER'=U D 139 . N ORIFN,ORES,ORI 140 . ; to match 56, need to VERIFY any replaced orders: 141 . S ORIFN=ORID,ORES(ORIFN)="" D REPLCD^ORCACT1 142 . S ORI="" F S ORI=$O(ORES(ORI)) Q:ORI="" D EN^ORCSEND(ORI,"VR","",""),UNLK1^ORX2(+ORI):ORI'=ORID ;ORID locked prior 143 D GETBYIFN^ORWORR(.REC,ORID) 144 Q 145 ALERT(DUMMY,ORID,ORDUZ) ;send alert to user (ORDUZ) when order (ORID) resulted 146 ;if no user passed from GUI, use ordering provider: 147 I $G(ORDUZ)<1 S ORDUZ=+$$ORDERER^ORQOR2(+ORID) 148 I $L($G(ORDUZ))<1 S ORDUZ=DUZ 149 S DUMMY=1,$P(^OR(100,+ORID,3),U,10)=ORDUZ 150 Q 151 FLAG(REC,ORIFN,OREASON,ORNP) ; Flag an order 152 N ORB,ORVP,DA,ORPS 153 D BULLETIN 154 S DA=$P(ORIFN,";",2),ORVP=+$P(^OR(100,+ORIFN,0),U,2) 155 K ^OR(100,+ORIFN,8,DA,3) S ^(3)="1^"_$G(XMZ)_U_+$E($$NOW^XLFDT,1,12)_U_DUZ_U_OREASON 156 D KILL^XM,MSG^ORCFLAG(ORIFN) 157 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; Last Activity 158 I +$G(ORNP)<1 S ORNP=+$P($G(^OR(100,+ORIFN,8,DA,0)),U,3) 159 S ORB=+ORVP_U_+ORIFN_U_ORNP_"^1" D EN^OCXOERR(ORB) ; notification 160 D GETBYIFN^ORWORR(.REC,ORIFN) 161 Q 162 BULLETIN ; Send flagged order bulletin (USED BY FLAG) 163 N OR0,OR3,ORDTXT,XMB,XMY,XMDUZ,ORENT,BULL,ORSRV,ORUSR 164 S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)) 165 ;CLA - 3/21/96: 166 S ORUSR=+$P(OR0,U,4) 167 S ORSRV=$G(^VA(200,ORUSR,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) 168 S ORENT="USR.`"_ORUSR_"^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG" 169 S BULL=$$GET^XPAR(ORENT,"ORB FLAGGED ORDERS BULLETIN",1,"Q") 170 Q:$G(BULL)'="Y" ;quit if parameter value is not 'Y'es 171 ; 172 S XMB="OR FLAGGED ORDER",XMDUZ=DUZ,XMY(+$P(OR0,U,4))="" 173 S XMB(1)=$P(^DPT(+$P(OR0,U,2),0),U),XMB(2)=$P(^(0),U,9),XMB(3)="" ;sb AGE 174 S XMB(4)=$$FMTE^XLFDT($P(OR0,U,7)) 175 D TEXT^ORQ12(.ORDTXT,+ORIFN,80) 176 S XMB(5)=$G(ORDTXT(1)),XMB(6)=$G(ORDTXT(2)),XMB(7)=$G(ORDTXT(3)) 177 S XMB(8)=$$FMTE^XLFDT($P(OR0,U,8)),XMB(9)=$$FMTE^XLFDT($P(OR0,U,9)),XMB(10)=OREASON 178 S XMB(11)=$P($G(^ORD(100.01,+$P(OR3,U,3),0)),U) 179 D EN^XMB 180 Q 181 UNFLAG(REC,ORIFN,OREASON) ; Unflag an order 182 N DA,ORB,ORNP,ORVP,ORPS 183 S DA=$P(ORIFN,";",2),ORVP=+$P(^OR(100,+ORIFN,0),U,2) 184 S $P(^OR(100,+ORIFN,8,DA,3),U)=0,$P(^(3),U,6,8)=+$E($$NOW^XLFDT,1,12)_U_DUZ_U_OREASON D MSG^ORCFLAG(ORIFN) 185 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; Last Activity 186 S ORNP=+$P($G(^OR(100,+ORIFN,8,DA,0)),U,3) 187 S ORB=+ORVP_U_+ORIFN_U_ORNP_"^0" D EN^OCXOERR(ORB) ; notification 188 D GETBYIFN^ORWORR(.REC,ORIFN) 189 Q 190 FLAGTXT(LST,ORID) ; Return flag reason 191 N FLAG 192 S FLAG=$G(^OR(100,+ORID,8,$P(ORID,";",2),3)) 193 S LST(1)="FLAGGED: "_$$FMTE^XLFDT($P(FLAG,U,3))_" by "_$P($G(^VA(200,+$P(FLAG,U,4),0)),U) 194 S LST(2)=$P(FLAG,U,5) ; reason 195 Q 196 WCGET(LST,ORID) ; Return ward comments 197 N I,ORIFN,ACT S ORIFN=+ORID,ACT=+$P(ORID,";",2) 198 S I=0 F S I=$O(^OR(100,ORIFN,8,ACT,5,I)) Q:'I S LST(I)=$G(^(I,0)) 199 Q 200 WCPUT(ERR,ORID,WCLST) ; Set ward comments for order 201 N DIERR,ERRLST,ORIFN,ACT S ORIFN=+ORID,ACT=+$P(ORID,";",2) 202 D WP^DIE(100.008,ACT_","_ORIFN_",",50,"","WCLST","ERRLST") 203 S ERR="" I $D(DIERR) S ERR="An error occurred while saving comments." 204 Q 205 OFCPLX(ORY,ORID,PRTORDER) ;Check if ORID is an child of the PRTORDER 206 N NUMCHDS,NOWID,NOWVAL,X3,ORDA,ISNOW 207 Q:'$D(^OR(100,+ORID,0)) 208 S ISNOW=0 209 D ISNOW^ORWDXR(.ISNOW,+ORID) 210 Q:ISNOW 211 N PKG 212 S PKG=$P($G(^OR(100,+ORID,0)),U,14) 213 S PKG=$$NMSP^ORCD(PKG) 214 I PKG'="PS" Q 215 I $L($G(^OR(100,+ORID,3))),('$L($P(^(3),U,9))) Q 216 S (NUMCHDS,NOWID,NOWVAL,X3,ORDA)=0 217 S PRTORDER=+$P(^(3),U,9) 218 S X3=$G(^OR(100,PRTORDER,3)),ORDA=$P(X3,U,7) 219 S PRTORDER=PRTORDER_";"_ORDA 220 S NUMCHDS=$P($G(^OR(100,+PRTORDER,2,0)),U,4) 221 I NUMCHDS>2 S ORY="COMPLEX-PSI"_U_PRTORDER 222 S:$D(^OR(100,+PRTORDER,4.5,"ID","NOW")) NOWID=$O(^("NOW",0)) 223 S:NOWID NOWVAL=$G(^OR(100,+PRTORDER,4.5,NOWID,1)) 224 I NOWVAL=1 Q 225 E S ORY="COMPLEX-PSI"_U_PRTORDER 226 Q 227 ISACTOI(ORY,OI) ;If it's an active orderable item 228 I $G(^ORD(101.43,+OI,.1)),^(.1)'>$$NOW^XLFDT D 229 . S ORY=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore." 230 Q
Note:
See TracChangeset
for help on using the changeset viewer.
