- 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/ORCACT2.m
r613 r623 1 ORCACT2 ;SLC/MKB-DC orders ; 03/27/2007 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,48,79,92,108,94,141,149,265,243**;Dec 17, 1997;Build 242 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 DC ; -- start here with: 5 ; ORNMBR = #,#,...,# of selected orders 6 ; 7 ; OREBUILD defined on return if Orders tab needs to be rebuilt 8 ; 9 N ORACT,ORI,NMBR,ORQUIT,ORIFN,ORDC,OREVT,ORNATR,ORPTLK,ORLK,IDX,ORDITM,ORPRINT,ORERR,ORSTS,ORPRNT,ORCLNUP,ORDA,ORCREATE,OR0,OR3,OREASON,ORXNP,ORX S VALMBCK="" 10 S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q 11 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") G:'ORNMBR DCQ 12 D FREEZE^ORCMENU S ORACT="DC",VALMBCK="R" K OREBUILD 13 DC1 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT) 14 . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)) 15 . S ORIFN=$S(ORTAB="MEDS":$P(IDX,U,4),1:$P(IDX,U)) Q:'ORIFN 16 . I '$D(^OR(100,+ORIFN,0)) W !,"This order has been deleted!" H 1 Q 17 . S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";"_+$P($G(^OR(100,+ORIFN,3)),U,7) 18 . S ORDITM=$$ORDITEM(ORIFN) D SUBHDR(ORDITM) 19 . I '$$VALID^ORCACT0(ORIFN,ORACT,.ORERR) W !,ORERR H 1 Q 20 . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !,$P(ORLK,U,2) H 1 Q 21 . S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORSTS=$P($G(^(8,+$P(ORIFN,";",2),0)),U,15) 22 . S:$P(OR0,U,17) OREVT(+$P(OR0,U,17))="" ;ck event when done 23 . I (ORSTS=10)!(ORSTS=11) D UNREL Q ;delete unreleased orders 24 . I $P(OR0,U,11)=$O(^ORD(100.98,"B","TF",0)),$P(OR3,U,3)=6 D RESUME(ORIFN) Q:$G(ORQUIT) 25 DC2 . S ORDC(ORI)=ORIFN I $$NMSP^ORCD(+$P(OR0,U,14))="PS" S ORX=1 D ;meds 26 .. I $P(OR3,U,9),$$VALUE^ORX8(+ORIFN,"SCHEDULE")'="NOW",$$DOSES^ORCACT4($P(OR3,U,9))>1 D 27 ... N I,X S ORDC("DAD",+$P(OR3,U,9),+ORIFN)="" 28 ... W !,$C(7),"This is part of a complex order, which will be discontinued in its entirety:" 29 ... S I=0 F S I=$O(^OR(100,+$P(OR3,U,9),8,1,.1,I)) Q:I<1 S X=$G(^(I,0)) W:$$UP^XLFSTR(X)'=" FIRST DOSE NOW" !,X 30 .. N ORY,ORJ,ORV,ORTX,DA,DIK D DELAYED^ORX8(.ORY,+ORIFN) Q:ORY'>0 31 .. W !,+ORY_" delayed order(s) for the same medication were found:" 32 .. S ORJ=0 F S ORJ=$O(ORY(ORJ)) Q:ORJ'>0 S ORV=ORY(ORJ) D TEXT^ORQ12(.ORTX,ORJ) W !,$E(ORTX(1),1,75)_$S($L(ORTX(1))>75:"...",1:""),!," >> delayed until "_$P(ORV,U,2) 33 .. I '$$OK(+ORY) W ! Q 34 .. W !,"Orders not signed or released to the service will be deleted.",! 35 .. S DIK="^OR(100,",DA=0 F S DA=$O(ORY(DA)) Q:DA'>0 D 36 ... N ORJ,ORSIG,STS,ORLKD 37 ... S ORLKD=$$LOCK1^ORX2(+DA) I 'ORLKD W !,$P(ORLKD,U,2) H 1 Q 38 ... S STS=$P($G(^OR(100,DA,3)),U,3),ORSIG=$S($P($G(^(8,1,0)),U,4)=2:0,1:1) 39 ... I STS'=10 S ORDC($$NXT)=DA Q ;released - add to list 40 ... D CLRDLY(DA):ORSIG,^DIK:'ORSIG S OREVT(+ORY(DA))="" 41 ... I $D(^TMP("ORNEW",$J,DA,1)) K ^(1) D UNLK1^ORX2(DA) ;unlock again 42 G:'$O(ORDC(0)) DCQ D:$D(ORDC("DAD")) COMPLX 43 DC3 S OREASON=$$DCREASON I OREASON'>0 D UNLOCK G DCQ 44 S ORNATR=$P(OREASON,U,3),ORCREATE=1 ; CHGD $$CREATE^ORX1(ORNATR) 45 I 'ORCREATE,$G(ORX),$D(^XUSEC("OREMAS",DUZ)),$$GET^XPAR("ALL","OR OREMAS MED ORDERS")<2 W $C(7),!,"You are not authorized to release med orders.",! G DC3 46 I ORCREATE D I (ORNP="^")!($G(ORL)="^") D UNLOCK G DCQ 47 . S ORNP=$$PROVIDER^ORCMENU1 Q:ORNP="^" ;S:ORNP=DUZ ORNATR="E" 48 . I $G(ORX) D PROVIDER^ORCDPSIV I $G(ORQUIT) S ORNP="^" Q 49 . S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 50 W ! W:'ORCREATE "Discontinuing orders ..." 51 S ORPRNT=$$PRINT(ORNATR),ORCLNUP=$S(ORNATR="D":1,ORNATR="M":1,1:0) 52 S (ORI,ORPRINT)=0 F S ORI=$O(ORDC(ORI)) Q:ORI'>0 S ORIFN=ORDC(ORI) D 53 . I ORCREATE S ORDA=$$ACTION^ORCSAVE("DC",+ORIFN,ORNP) Q:'ORDA D SET(+ORIFN,ORNATR,+OREASON,$P(OREASON,U,2)) S ^TMP("ORNEW",$J,+ORIFN,ORDA)="" W "." Q 54 . ; release -> no order or ES req'd 55 . D EN^ORCSEND(+ORIFN,ORACT,3,1,ORNATR,+OREASON,.ORERR),UNLK1^ORX2(+ORIFN) 56 . I '$G(ORERR) S:$P(ORPRNT,U)!$P(ORPRNT,U,5) ORPRINT=ORPRINT+1,ORPRINT(ORPRINT)=+ORIFN_";" W "." Q 57 . W !,$$ORDITEM(+ORIFN)_" not discontinued." 58 . W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2) W ! H 1 59 W:ORCREATE "... discontinue order(s) placed." H 1 60 I $O(ORPRINT(0)) D PRINT^ORPR02(ORVP,.ORPRINT,,ORL,ORPRNT) 61 S OREBUILD=1 ; rebuild orders list 62 DCQ D:$G(OREBUILD) UNOTIF^ORCSIGN ; undo notif? 63 D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders 64 S:$G(ORXNP) ORNP=ORXNP ;reset provider if needed 65 D:$D(OREVT) EVENT ;cancel any events? 66 Q 67 ; 68 UNLOCK ; -- Unlock orders in ORDC(ORI)=ORIFN 69 N ORI,ORIFN S ORI=0 70 F S ORI=$O(ORDC(ORI)) Q:ORI'>0 S ORIFN=+ORDC(ORI) D UNLK1^ORX2(ORIFN) 71 Q 72 ; 73 OK(NUM) ; -- Ok to DC delayed order(s) too? 74 N X,Y,DIR S DIR(0)="YA",DIR("B")="NO" 75 S DIR("A")="Do you want to discontinue "_$S(NUM>1:"these orders",1:"this order")_" too? " 76 S DIR("?")="Enter YES to also cancel the delayed order(s), or NO to allow the order(s) to be activated when the designated event occurs." 77 W ! D ^DIR 78 Q +Y 79 ; 80 NXT() ; -- Return next available subscript in ORDC() 81 N Y S Y=$L(ORNMBR,",")+1 S:Y'>$O(ORDC(""),-1) Y=$O(ORDC(""),-1)+1 82 Q Y 83 ; 84 PRINT(NATR) ; -- Ok to print order? 85 N I,OR1,Y S I=$O(^ORD(100.02,"C",NATR,0)),OR1=$G(^ORD(100.02,I,1)) 86 S Y=$P(OR1,U,2)_"^^^^"_$P(OR1,U,5) 87 Q Y 88 ; 89 ORDITEM(ID) ; -- Returns order text 90 ;N X,I,MORE S X="" 91 ;I $P(ID,";",2)>1 S I=$P($G(^OR(100,+ID,8,+$P(ID,";",2),0)),U,2),X=$S(I="DC":"Discontinue ",I="HD":"Hold ",1:"") 92 ;S I=$O(^OR(100,+ID,1,0)) Q:'I "" S MORE=$O(^(I)),X=X_$G(^(I,0)) 93 ;I $L(X)>68 S X=$E(X,1,68),MORE=1 94 ;S:MORE X=X_" ..." 95 N X,ORX D TEXT^ORQ12(.ORX,ID,68) S X=ORX(1)_$S(ORX>1:" ...",1:"") 96 Q X 97 ; 98 SUBHDR(X) ; -- Display subheader of order being acted on 99 W !!,?(36-($L(X)\2)),"-- "_X_" --",! 100 Q 101 ; 102 COMPLX ; -- Ck for other child orders to be dc'd at same time 103 N DAD,CHLD 104 S DAD=0 F S DAD=$O(ORDC("DAD",DAD)) Q:DAD<1 D 105 . S CHLD=0 F S CHLD=$O(^OR(100,DAD,2,CHLD)) Q:CHLD<1 D 106 .. Q:"^1^2^7^12^13^14^15^"[(U_$P($G(^OR(100,CHLD,3)),U,3)_U) 107 .. Q:$D(ORDC("DAD",DAD,CHLD)) S ORDC($$NXT)=CHLD 108 Q 109 ; 110 DCREASON() ; -- Returns Reason for DC 111 N X,Y,DIC 112 ;I $D(^XUSEC("ORES",DUZ)) S Y=+$O(^ORD(100.03,"C","ORREQ",0)) I Y S Y(0)=$G(^ORD(100.03,Y,0)),Y=Y_U_$P(Y(0),U) G DCRQ ; silent 113 S DIC="^ORD(100.03,",DIC(0)="AEMQZ",DIC("B")=+$O(^ORD(100.03,"C","ORREQ",0)),DIC("W")="W:$L($P(^(0),U))>30 $E($P(^(0),U),31,999)" K:DIC("B")'>0 DIC("B") 114 S DIC("S")="I '$P(^(0),U,4),$P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0))_",$P(^(0),U,7)'="_+$O(^ORD(100.02,"C","A",0)),DIC("A")="REASON FOR DC: " 115 D ^DIC 116 DCRQ S:Y>0 Y=Y_U_$S($P(Y(0),U,7):$P($G(^ORD(100.02,+$P(Y(0),U,7),0)),U,2),1:"W") ; ^nature 117 Q Y 118 ; 119 SET(ORDER,NATURE,REASON,TEXT,DCORIG) ; -- Set DC Reason into 6-node 120 Q:'$G(ORDER) Q:'$D(^OR(100,+ORDER,0)) S ORDER=+ORDER 121 I $L($G(NATURE)),NATURE'>0 S NATURE=$O(^ORD(100.02,"C",NATURE,0)) 122 S $P(^OR(100,ORDER,6),U,1,5)=$G(NATURE)_U_DUZ_U_$E($$NOW^XLFDT,1,12)_U_$G(REASON)_U_$G(TEXT),$P(^(6),U,9)=$G(DCORIG) 123 Q 124 ; 125 RESUME(ORDER) ; -- Resume tray service when dc'ing tubefeeding ORDER? 126 N X,Y,DIR,DIC,DA S X=$$RESUME^FHWORR(+ORVP) 127 I '$L(X) W !,"NOTE: NO current diet order exists for this patient!" Q 128 Q:'X I X=2 W !,"Note: Patient is on a WITHHOLD SERVICE order!" 129 S DIR(0)="YA",DIR("A")="Do you wish to resume tray service? " 130 S DIR("?")="Enter YES to resume the previous diet order",DIR("B")="NO" 131 D ^DIR I Y'=1 S:$D(DTOUT)!(X["^") ORQUIT=1 132 D:Y=1 RESUME^ORCSAVE(+ORDER) 133 Q 134 ; 135 UNREL ; -- Process unreleased/delayed order 136 N ORA,ORA0,DA,DR,DIE 137 S ORA=+$P(ORIFN,";",2),ORA0=$G(^OR(100,+ORIFN,8,ORA,0)) 138 ;S ORDEL=$S(ORSTS=11:1,$P(ORA0,U,4)=2:1,1:0) 139 ;W !,"This order was not released "_$S(ORDEL:"to the service and will be deleted.",1:"but signed and will be cancelled.") 140 K:$P(ORA0,U,2)="DC" ^OR(100,+ORIFN,6) I $P(ORA0,U,2)="NW" D 141 . S:$P(OR3,U,5) $P(^OR(100,+$P(OR3,U,5),3),U,6)="" 142 . I $P(OR0,U,17) S DA=+$O(^ORE(100.2,"AO",+ORIFN,0)) I DA S DR="4///@",DIE=100.2 D ^DIE 143 D UNLK1^ORX2(+ORIFN) S OREBUILD=1 144 I $D(^TMP("ORNEW",$J,+ORIFN,ORA)) K ^(ORA) D Q ;new this session 145 . W !,"This order will be deleted." H 1 146 . D DELETE^ORCSAVE2(ORIFN),UNLK1^ORX2(+ORIFN) ;decrement lock again 147 W !,"This order was not released and will be cancelled." H 1 148 D CANCEL^ORCSAVE2(ORIFN):ORSTS=11,CLRDLY(+ORIFN):ORSTS=10 149 Q 150 ; 151 CLRDLY(IFN) ; -- [old Clear delayed fields] Cancel delayed [event]order 152 N STS,ORX S IFN=+$G(IFN) Q:IFN'>0 153 Q:'$D(^OR(100,IFN,0)) S STS=$P($G(^(3)),U,3) 154 S ORX="Delayed "_$S(STS=10:"Order",1:"Release Event")_" Cancelled" 155 S ^OR(100,IFN,6)=$O(^ORD(100.02,"C","M",0))_U_DUZ_U_+$E($$NOW^XLFDT,1,12)_U_U_ORX 156 D STATUS^ORCSAVE2(IFN,13) S $P(^OR(100,IFN,8,1,0),U,15)=13 157 Q 158 ; 159 EVENT ; -- Cancel event too? 160 N EVT,X 161 S EVT=0 F S EVT=$O(OREVT(EVT)) Q:EVT<1 D Q:$G(ORQUIT) 162 . Q:$G(^ORE(100.2,EVT,1)) Q:'$$EMPTY^OREVNTX(EVT) ;done or has orders 163 . ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders." 164 . ;S DIR(0)="YA",DIR("A")="Do you want to cancel this event? " 165 . ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it." 166 . ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q 167 . D CANCEL^OREVNTX(EVT) S X=$P($$NAME^OREVNTX(EVT)," ",2,99) 168 . W !," ... "_X_" event cancelled." H 1 169 . I $G(OREVENT),OREVENT=EVT D EX^OREVNT ;Return to Active Orders 170 Q 171 ; 172 DCD(IFN) ; -- order discontinued already? 173 N STS,Y,I S Y=0 I '$G(IFN) Q 1 174 S STS=+$P($G(^OR(100,+IFN,3)),U,3) 175 I "^1^2^7^12^13^14^"[(U_STS_U) S Y=1 G DQ ;terminal sts 176 ;look for existing DC action awaiting ES: 177 S I=0 F S I=+$O(^OR(100,+IFN,8,"C","DC",I)) Q:I<1 I $P($G(^OR(100,+IFN,8,I,0)),U,15)=11 S Y=1 Q 178 DQ Q Y 1 ORCACT2 ;SLC/MKB-DC orders ; 08 May 2002 2:12 PM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,48,79,92,108,94,141,149,265**;Dec 17, 1997;Build 17 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 DC ; -- start here with: 5 ; ORNMBR = #,#,...,# of selected orders 6 ; 7 ; OREBUILD defined on return if Orders tab needs to be rebuilt 8 ; 9 N ORACT,ORI,NMBR,ORQUIT,ORIFN,ORDC,OREVT,ORNATR,ORPTLK,ORLK,IDX,ORDITM,ORPRINT,ORERR,ORSTS,ORPRNT,ORCLNUP,ORDA,ORCREATE,OR0,OR3,OREASON,ORXNP,ORX S VALMBCK="" 10 S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q 11 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") G:'ORNMBR DCQ 12 D FREEZE^ORCMENU S ORACT="DC",VALMBCK="R" K OREBUILD 13 DC1 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT) 14 . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)) 15 . S ORIFN=$S(ORTAB="MEDS":$P(IDX,U,4),1:$P(IDX,U)) Q:'ORIFN 16 . I '$D(^OR(100,+ORIFN,0)) W !,"This order has been deleted!" H 1 Q 17 . S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";"_+$P($G(^OR(100,+ORIFN,3)),U,7) 18 . S ORDITM=$$ORDITEM(ORIFN) D SUBHDR(ORDITM) 19 . I '$$VALID^ORCACT0(ORIFN,ORACT,.ORERR) W !,ORERR H 1 Q 20 . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !,$P(ORLK,U,2) H 1 Q 21 . S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORSTS=$P($G(^(8,+$P(ORIFN,";",2),0)),U,15) 22 . S:$P(OR0,U,17) OREVT(+$P(OR0,U,17))="" ;ck event when done 23 . I (ORSTS=10)!(ORSTS=11) D UNREL Q ;delete unreleased orders 24 . I $P(OR0,U,11)=$O(^ORD(100.98,"B","TF",0)),$P(OR3,U,3)=6 D RESUME(ORIFN) Q:$G(ORQUIT) 25 DC2 . S ORDC(ORI)=ORIFN I $$NMSP^ORCD(+$P(OR0,U,14))="PS" S ORX=1 D ;meds 26 .. I $P(OR3,U,9),$$VALUE^ORX8(+ORIFN,"SCHEDULE")'="NOW",$$DOSES^ORCACT4($P(OR3,U,9))>1 D 27 ... N I,X S ORDC("DAD",+$P(OR3,U,9),+ORIFN)="" 28 ... W !,$C(7),"This is part of a complex order, which will be discontinued in its entirety:" 29 ... S I=0 F S I=$O(^OR(100,+$P(OR3,U,9),8,1,.1,I)) Q:I<1 S X=$G(^(I,0)) W:$$UP^XLFSTR(X)'=" FIRST DOSE NOW" !,X 30 .. N ORY,ORJ,ORV,ORTX,DA,DIK D DELAYED^ORX8(.ORY,+ORIFN) Q:ORY'>0 31 .. W !,+ORY_" delayed order(s) for the same medication were found:" 32 .. S ORJ=0 F S ORJ=$O(ORY(ORJ)) Q:ORJ'>0 S ORV=ORY(ORJ) D TEXT^ORQ12(.ORTX,ORJ) W !,$E(ORTX(1),1,75)_$S($L(ORTX(1))>75:"...",1:""),!," >> delayed until "_$P(ORV,U,2) 33 .. I '$$OK(+ORY) W ! Q 34 .. W !,"Orders not signed or released to the service will be deleted.",! 35 .. S DIK="^OR(100,",DA=0 F S DA=$O(ORY(DA)) Q:DA'>0 D 36 ... N ORJ,ORSIG,STS,ORLKD 37 ... S ORLKD=$$LOCK1^ORX2(+DA) I 'ORLKD W !,$P(ORLKD,U,2) H 1 Q 38 ... S STS=$P($G(^OR(100,DA,3)),U,3),ORSIG=$S($P($G(^(8,1,0)),U,4)=2:0,1:1) 39 ... I STS'=10 S ORDC($$NXT)=DA Q ;released - add to list 40 ... D CLRDLY(DA):ORSIG,^DIK:'ORSIG S OREVT(+ORY(DA))="" 41 ... I $D(^TMP("ORNEW",$J,DA,1)) K ^(1) D UNLK1^ORX2(DA) ;unlock again 42 G:'$O(ORDC(0)) DCQ D:$D(ORDC("DAD")) COMPLX 43 DC3 S OREASON=$$DCREASON I OREASON'>0 D UNLOCK G DCQ 44 S ORNATR=$P(OREASON,U,3),ORCREATE=1 ; CHGD $$CREATE^ORX1(ORNATR) 45 I 'ORCREATE,$G(ORX),$D(^XUSEC("OREMAS",DUZ)),$$GET^XPAR("ALL","OR OREMAS MED ORDERS")<2 W $C(7),!,"You are not authorized to release med orders.",! G DC3 46 I ORCREATE D I (ORNP="^")!($G(ORL)="^") D UNLOCK G DCQ 47 . S ORNP=$$PROVIDER^ORCMENU1 Q:ORNP="^" ;S:ORNP=DUZ ORNATR="E" 48 . I $G(ORX) D PROVIDER^ORCDPSIV I $G(ORQUIT) S ORNP="^" Q 49 . S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 50 W ! W:'ORCREATE "Discontinuing orders ..." 51 S ORPRNT=$$PRINT(ORNATR),ORCLNUP=$S(ORNATR="D":1,ORNATR="M":1,1:0) 52 S (ORI,ORPRINT)=0 F S ORI=$O(ORDC(ORI)) Q:ORI'>0 S ORIFN=ORDC(ORI) D 53 . I ORCREATE S ORDA=$$ACTION^ORCSAVE("DC",+ORIFN,ORNP) Q:'ORDA D SET(+ORIFN,ORNATR,+OREASON,$P(OREASON,U,2)) S ^TMP("ORNEW",$J,+ORIFN,ORDA)="" W "." Q 54 . ; release -> no order or ES req'd 55 . D EN^ORCSEND(+ORIFN,ORACT,3,1,ORNATR,+OREASON,.ORERR),UNLK1^ORX2(+ORIFN) 56 . I '$G(ORERR) S:$P(ORPRNT,U)!$P(ORPRNT,U,5) ORPRINT=ORPRINT+1,ORPRINT(ORPRINT)=+ORIFN_";" W "." Q 57 . W !,$$ORDITEM(+ORIFN)_" not discontinued." 58 . W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2) W ! H 1 59 W:ORCREATE "... discontinue order(s) placed." H 1 60 I $O(ORPRINT(0)) D PRINT^ORPR02(ORVP,.ORPRINT,,ORL,ORPRNT) 61 S OREBUILD=1 ; rebuild orders list 62 DCQ D:$G(OREBUILD) UNOTIF^ORCSIGN ; undo notif? 63 D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders 64 S:$G(ORXNP) ORNP=ORXNP ;reset provider if needed 65 D:$D(OREVT) EVENT ;cancel any events? 66 Q 67 ; 68 UNLOCK ; -- Unlock orders in ORDC(ORI)=ORIFN 69 N ORI,ORIFN S ORI=0 70 F S ORI=$O(ORDC(ORI)) Q:ORI'>0 S ORIFN=+ORDC(ORI) D UNLK1^ORX2(ORIFN) 71 Q 72 ; 73 OK(NUM) ; -- Ok to DC delayed order(s) too? 74 N X,Y,DIR S DIR(0)="YA",DIR("B")="NO" 75 S DIR("A")="Do you want to discontinue "_$S(NUM>1:"these orders",1:"this order")_" too? " 76 S DIR("?")="Enter YES to also cancel the delayed order(s), or NO to allow the order(s) to be activated when the designated event occurs." 77 W ! D ^DIR 78 Q +Y 79 ; 80 NXT() ; -- Return next available subscript in ORDC() 81 N Y S Y=$L(ORNMBR,",")+1 S:Y'>$O(ORDC(""),-1) Y=$O(ORDC(""),-1)+1 82 Q Y 83 ; 84 PRINT(NATR) ; -- Ok to print order? 85 N I,OR1,Y S I=$O(^ORD(100.02,"C",NATR,0)),OR1=$G(^ORD(100.02,I,1)) 86 S Y=$P(OR1,U,2)_"^^^^"_$P(OR1,U,5) 87 Q Y 88 ; 89 ORDITEM(ID) ; -- Returns order text 90 ;N X,I,MORE S X="" 91 ;I $P(ID,";",2)>1 S I=$P($G(^OR(100,+ID,8,+$P(ID,";",2),0)),U,2),X=$S(I="DC":"Discontinue ",I="HD":"Hold ",1:"") 92 ;S I=$O(^OR(100,+ID,1,0)) Q:'I "" S MORE=$O(^(I)),X=X_$G(^(I,0)) 93 ;I $L(X)>68 S X=$E(X,1,68),MORE=1 94 ;S:MORE X=X_" ..." 95 N X,ORX D TEXT^ORQ12(.ORX,ID,68) S X=ORX(1)_$S(ORX>1:" ...",1:"") 96 Q X 97 ; 98 SUBHDR(X) ; -- Display subheader of order being acted on 99 W !!,?(36-($L(X)\2)),"-- "_X_" --",! 100 Q 101 ; 102 COMPLX ; -- Ck for other child orders to be dc'd at same time 103 N DAD,CHLD 104 S DAD=0 F S DAD=$O(ORDC("DAD",DAD)) Q:DAD<1 D 105 . S CHLD=0 F S CHLD=$O(^OR(100,DAD,2,CHLD)) Q:CHLD<1 D 106 .. Q:"^1^2^7^12^13^14^15^"[(U_$P($G(^OR(100,CHLD,3)),U,3)_U) 107 .. Q:$D(ORDC("DAD",DAD,CHLD)) S ORDC($$NXT)=CHLD 108 Q 109 ; 110 DCREASON() ; -- Returns Reason for DC 111 N X,Y,DIC 112 ;I $D(^XUSEC("ORES",DUZ)) S Y=+$O(^ORD(100.03,"C","ORREQ",0)) I Y S Y(0)=$G(^ORD(100.03,Y,0)),Y=Y_U_$P(Y(0),U) G DCRQ ; silent 113 S DIC="^ORD(100.03,",DIC(0)="AEMQZ",DIC("B")=+$O(^ORD(100.03,"C","ORREQ",0)),DIC("W")="W:$L($P(^(0),U))>30 $E($P(^(0),U),31,999)" K:DIC("B")'>0 DIC("B") 114 S DIC("S")="I '$P(^(0),U,4),$P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0))_",$P(^(0),U,7)'="_+$O(^ORD(100.02,"C","A",0)),DIC("A")="REASON FOR DC: " ;is referenced by DBIA #2058 115 D ^DIC 116 DCRQ S:Y>0 Y=Y_U_$S($P(Y(0),U,7):$P($G(^ORD(100.02,+$P(Y(0),U,7),0)),U,2),1:"W") ; ^nature 117 Q Y 118 ; 119 SET(ORDER,NATURE,REASON,TEXT) ; -- Set DC Reason into 6-node 120 Q:'$G(ORDER) Q:'$D(^OR(100,+ORDER,0)) S ORDER=+ORDER 121 I $L($G(NATURE)),NATURE'>0 S NATURE=$O(^ORD(100.02,"C",NATURE,0)) 122 S ^OR(100,ORDER,6)=$G(NATURE)_U_DUZ_U_$E($$NOW^XLFDT,1,12)_U_$G(REASON)_U_$G(TEXT) 123 Q 124 ; 125 RESUME(ORDER) ; -- Resume tray service when dc'ing tubefeeding ORDER? 126 N X,Y,DIR,DIC,DA S X=$$RESUME^FHWORR(+ORVP) 127 I '$L(X) W !,"NOTE: NO current diet order exists for this patient!" Q 128 Q:'X I X=2 W !,"Note: Patient is on a WITHHOLD SERVICE order!" 129 S DIR(0)="YA",DIR("A")="Do you wish to resume tray service? " 130 S DIR("?")="Enter YES to resume the previous diet order",DIR("B")="NO" 131 D ^DIR I Y'=1 S:$D(DTOUT)!(X["^") ORQUIT=1 132 D:Y=1 RESUME^ORCSAVE(+ORDER) 133 Q 134 ; 135 UNREL ; -- Process unreleased/delayed order 136 N ORA,ORA0,ORDEL,DA,DR,DIE 137 S ORA=+$P(ORIFN,";",2),ORA0=$G(^OR(100,+ORIFN,8,ORA,0)) 138 S ORDEL=$S(ORSTS=11:1,$P(ORA0,U,4)=2:1,1:0) 139 W !,"This order was not released "_$S(ORDEL:"to the service and will be deleted.",1:"but signed and will be cancelled.") H 1 I ORDEL D 140 . K:$P(ORA0,U,2)="DC" ^OR(100,+ORIFN,6) I $P(ORA0,U,2)="NW" D 141 .. S:$P(OR3,U,5) $P(^OR(100,+$P(OR3,U,5),3),U,6)="" 142 .. I $P(OR0,U,17) S DA=+$O(^ORE(100.2,"AO",+ORIFN,0)) I DA S DR="4///@",DIE=100.2 D ^DIE 143 . D DELETE^ORCSAVE2(ORIFN) 144 D CLRDLY(+ORIFN):'ORDEL,UNLK1^ORX2(+ORIFN) S OREBUILD=1 145 I $D(^TMP("ORNEW",$J,+ORIFN,ORA)) K ^(ORA) D UNLK1^ORX2(+ORIFN) ;decrement lock again 146 Q 147 ; 148 EVENT ; -- Cancel event too? 149 N EVT,X 150 S EVT=0 F S EVT=$O(OREVT(EVT)) Q:EVT<1 D Q:$G(ORQUIT) 151 . Q:$G(^ORE(100.2,EVT,1)) Q:'$$EMPTY^OREVNTX(EVT) ;done or has orders 152 . ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders." 153 . ;S DIR(0)="YA",DIR("A")="Do you want to cancel this event? " 154 . ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it." 155 . ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q 156 . D CANCEL^OREVNTX(EVT) S X=$P($$NAME^OREVNTX(EVT)," ",2,99) 157 . W !," ... "_X_" event cancelled." H 1 158 . I $G(OREVENT),OREVENT=EVT D EX^OREVNT ;Return to Active Orders 159 Q 160 ; 161 DCD(IFN) ; -- order discontinued already? 162 N STS,Y,I S Y=0 I '$G(IFN) Q 1 163 S STS=+$P($G(^OR(100,+IFN,3)),U,3) 164 I "^1^2^7^12^13^14^"[(U_STS_U) S Y=1 G DQ ;terminal sts 165 ;look for existing DC action awaiting ES: 166 S I=0 F S I=+$O(^OR(100,+IFN,8,"C","DC",I)) Q:I<1 I $P($G(^OR(100,+IFN,8,I,0)),U,15)=11 S Y=1 Q 167 DQ Q Y 168 ; 169 CLRDLY(IFN) ; -- [old Clear delayed fields] Cancel delayed [event]order 170 N STS,ORX S IFN=+$G(IFN) Q:IFN'>0 171 Q:'$D(^OR(100,IFN,0)) S STS=$P($G(^(3)),U,3) 172 S ORX="Delayed "_$S(STS=10:"Order",1:"Release Event")_" Cancelled" 173 S ^OR(100,IFN,6)=$O(^ORD(100.02,"C","M",0))_U_DUZ_U_+$E($$NOW^XLFDT,1,12)_U_U_ORX 174 D STATUS^ORCSAVE2(IFN,13) S $P(^OR(100,IFN,8,1,0),U,15)=13 175 Q
Note:
See TracChangeset
for help on using the changeset viewer.
