- 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/ORCSEND.m
r613 r623 1 ORCSEND ;SLC/MKB-Release orders ; 11/8/2006 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,27,45,79,92,141,165,195,243**;Dec 17, 1997;Build 242 3 ; 4 EN(ORIFN,ACTION,SIGSTS,RELSTS,NATURE,REASON,ORERR) ; -- Release [actions on] orders 5 N ORDA,ORNOW,SIGNREQD,SIGNED,SIGNER 6 S SIGNREQD=+$P($G(^OR(100,+ORIFN,0)),U,16),ORERR="" 7 S SIGNED=$S(SIGSTS=2:0,1:1),SIGNER=$S(SIGSTS=1:DUZ,SIGSTS=7:DUZ,1:"") 8 S ORDA=+$P(ORIFN,";",2),ORIFN=+ORIFN,ORNOW=+$E($$NOW^XLFDT,1,12) 9 S:"ES"[$G(ACTION) ACTION=$P($G(^OR(100,ORIFN,8,ORDA,0)),U,2) 10 I SIGNREQD,ORDA,"^NW^RW^XX^RN^DC^HD^RL^"[(U_ACTION_U) D ; sign/alert 11 . I 'SIGNED D NOTIF^ORCSIGN Q 12 . D:SIGSTS'="" SIGN^ORCSAVE2(ORIFN,SIGNER,ORNOW,SIGSTS,ORDA) 13 . D:SIGSTS=4 CHART^ORCSIGN ; not used anymore 14 I '$L(ACTION) S ORERR="1^Invalid order action" Q 15 I $$READY(ORIFN,ORDA) D:$L($T(@ACTION)) @ACTION I 'ORERR,ACTION="NW" D 16 . N OREVT S OREVT=+$P($G(^OR(100,ORIFN,0)),U,17) Q:OREVT<1 17 . I '$$EVTORDER^OREVNTX(ORIFN) D SAVE^ORMEVNT1(ORIFN,OREVT,2,"ES") 18 ; If order originated from the back door, send Dx and TxF back to ancil. 19 I SIGNED,$P($G(^OR(100,+ORIFN,3)),U,11)="P" D BDOEDIT^ORWDBA7 20 Q 21 ; 22 EN1(ORDER,ORERR) ; -- Delayed Release [from RELEASE^ORMEVNT] 23 ; 24 Q:$P($G(^OR(100,+ORDER,3)),U,3)'=10 25 N ORPKG,ORA0,ORNOW,ORIFN,ORDA,ORNP,ORNATR,ORQUIT,ORDUZ,SIGSTS,RELSTS 26 S ORPKG=$P($G(^OR(100,+ORDER,0)),U,14),ORA0=$G(^(8,1,0)) 27 S ORNOW=+$E($$NOW^XLFDT,1,12),ORIFN=+ORDER,ORDA=1,ORNP=$P(ORA0,U,3) 28 S SIGSTS=$P(ORA0,U,4),ORNATR=$P($G(^ORD(100.02,+$P(ORA0,U,12),0)),U,2) 29 S RELSTS=$S(SIGSTS'=2:1,"^V^P^"[(U_ORNATR_U):1,1:0) I RELSTS D 30 . D STARTDT^ORCSAVE2(ORIFN),PKGSTUFF^ORCSEND1(ORPKG) Q:$G(ORQUIT) 31 . S ORDUZ=$S(SIGSTS=0:$P(ORA0,U,7),SIGSTS=1:$P(ORA0,U,5),SIGSTS=2:$P(ORA0,U,17),SIGSTS=3:$P(ORA0,U,13),1:DUZ) 32 . D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,ORDUZ),NEW^ORMBLD(ORIFN) 33 . I "^10^13^"[(U_$P($G(^OR(100,ORIFN,3)),U,3)_U) S ORERR=1 ;error 34 I 'RELSTS!$G(ORERR),$P($G(^OR(100,ORIFN,3)),U,3)=10 D STATUS^ORCSAVE2(ORIFN,11) S $P(^OR(100,ORIFN,8,1,0),U,15)=11 35 Q 36 ; 37 EN2(ORIFN,SIGSTS,NATURE,ORERR) ; -- Manual Release [from OREVNT1,SENDED^ORWDX] 38 N ORDA,ORNOW,OREVT,ORA0,ORNP,SIGNREQD,SIGNED,RELSTS 39 S ORDA=+$P(ORIFN,";",2),ORIFN=+ORIFN S:ORDA<1 ORDA=1 40 S OREVT=+$P($G(^OR(100,ORIFN,0)),U,17),ORA0=$G(^(8,ORDA,0)) 41 S ORNP=$P(ORA0,U,3),SIGNREQD=($P(ORA0,U,4)'=3),(SIGNED,RELSTS)=1 42 S ORNOW=+$E($$NOW^XLFDT,1,12),ORERR="" I $P(ORA0,U,4)=2 D ;needs ES 43 . N SIGNER S SIGNER=$S(SIGSTS=1:DUZ,1:"") 44 . I SIGSTS=2 D NOTIF^ORCSIGN S SIGNED=0 Q ;still unsigned 45 . D:SIGSTS'="" SIGN^ORCSAVE2(ORIFN,SIGNER,ORNOW,SIGSTS,ORDA) 46 D NW I 'ORERR D SAVE^ORMEVNT1(+ORIFN,OREVT,2,"MN") 47 Q 48 ; 49 NW ; -- New order ORIFN 50 RW ; -- Rewritten order ORIFN 51 XX ; -- Changed order ORIFN 52 RN ; -- Renewed order ORIFN 53 N ORQUIT,STS,TYPE,OR0,OR3,CODE,ORIG,ORSAVE 54 N IVDIEN,IVPKGM 55 S IVPKGM=0 56 S IVDIEN=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) 57 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG,OREBUILD=1 Q 58 S:'ORDA ORDA=1 S ORSAVE=ORIFN 59 S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)) D STARTDT^ORCSAVE2(ORIFN) 60 S TYPE=$P(OR3,U,11),ORIG=+$P(OR3,U,5),CODE="NW" 61 I TYPE=1,ORIG,$D(^OR(100,ORIG,4)) S CODE="XO",^OR(100,ORIG,6)=$O(^ORD(100.02,"C","C",0))_U_DUZ_U_ORNOW 62 I $$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)="PSJ" S IVPKGM=1 63 I IVPKGM=1,$P($P(OR0,U,5),";")=IVDIEN D PSJI^ORCSEND3 Q:$G(ORQUIT) 64 I IVPKGM=0!($P($P(OR0,U,5),";")'=IVDIEN) D PKGSTUFF^ORCSEND1(+$P(OR0,U,14)) Q:$G(ORQUIT) 65 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 66 D NEW^ORMBLD(ORIFN,CODE) S ORIFN=ORSAVE,STS=$P($G(^OR(100,ORIFN,3)),U,3) 67 I (STS=1)!(STS=13) S ORERR="1^"_$$WHY(ORIFN,1) D:'SIGNED&SIGNREQD NOSIG K:ORIG ^OR(100,ORIG,6) 68 I STS=11 S ORERR="1^ERROR" 69 Q 70 ; 71 DC ; -- DC order ORIFN 72 N PKG,CODE,ORCHLD,ORCHDA,STS,ORIDA,ORSAVE,OR3,OR6,DCNATURE 73 I '$G(REASON),$G(NATURE)="D" S REASON=+$O(^ORD(100.03,"C","ORDUP",0)) 74 S:$G(REASON) $P(^OR(100,ORIFN,6),U,1,5)=$S($G(NATURE):NATURE,$L($G(NATURE)):$O(^ORD(100.02,"C",NATURE,0)),1:"")_"^^^"_+REASON_U_$P(^ORD(100.03,+REASON,0),U) 75 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG Q 76 S $P(^OR(100,ORIFN,6),U,2,3)=$S($G(DGPMT):"",1:DUZ)_U_ORNOW,ORSAVE=ORIFN S:'$G(REASON) REASON=$P(^(6),U,4) 77 S STS=$P($G(^OR(100,ORIFN,3)),U,3),PKG=$P($G(^(0)),U,14),PKG=$$NMSP^ORCD(PKG),CODE=$S(PKG="LR":"CA",(PKG="PS")&(STS=5):"CA",(PKG="FH")&(STS=8):"CA",1:"DC") 78 D:ORDA RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 79 DC1 I $O(^OR(100,ORIFN,2,0)) D G DC2 ; DC children 80 . S ORCHLD=0 F S ORCHLD=$O(^OR(100,ORIFN,2,ORCHLD)) Q:ORCHLD'>0 I $$VALID^ORCACT0(ORCHLD,"DC") D Q:$G(ORERR) 81 . . S ORCHDA=$S(ORDA:$$ACTION^ORCSAVE("DC",ORCHLD,ORNP),1:0) 82 . . D:ORCHDA SIGN^ORCSAVE2(ORCHLD,,,8,ORCHDA) ;Sig on Parent only 83 . . D MSG^ORMBLD((ORCHLD_";"_ORCHDA),CODE,$G(REASON)) 84 . . I "^1^13^"'[(U_$P(^OR(100,ORCHLD,3),U,3)_U) S ORERR="1^"_$$WHY(ORCHLD,ORCHDA) 85 . ;D:'$G(ORERR) STATUS^ORCSAVE2(ORIFN,1) 86 . S:$G(ORERR) ^OR(100,ORIFN,8,ORDA,1)=$P(ORERR,U,2) 87 D MSG^ORMBLD((ORIFN_";"_ORDA),CODE,$G(REASON)) 88 DC2 S ORIFN=ORSAVE,OR3=$G(^OR(100,ORIFN,3)),STS=$P(OR3,U,3) 89 S OR6=$G(^OR(100,ORIFN,6)) 90 I STS'=1,STS'=13,STS'=2 D Q 91 . S ORERR="1^"_$S(ORDA:$$WHY(ORIFN,ORDA),1:"Unable to discontinue") 92 . I ORDA,'SIGNED&SIGNREQD D NOSIG ; sig no longer reqd 93 . K ^OR(100,ORIFN,6) 94 S DCNATURE=$S(+OR6:+OR6,1:$G(NATURE)) 95 S $P(^OR(100,ORIFN,3),U,7)=$S('$$ACTV^ORX1($G(DCNATURE)):0,1:$P(OR3,U,7)) 96 D CANCEL(ORIFN),SETALL^ORDD100(ORIFN) 97 I $P(OR3,U,11)=2 D ; dc a renewal 98 . N ORIG,ORIG3,NATR S ORIG=$P(OR3,U,5),ORIG3=$G(^OR(100,ORIG,3)) Q:'ORIG 99 . ;I CODE="CA",+$P(OR6,U,9)'>0 S $P(^OR(100,ORIG,3),U,6)="" Q ;pend - remove fwd ptr 100 . I +$P(OR6,U,9)'>0 S $P(^OR(100,ORIG,3),U,6)="" Q ;pend - remove fwd ptr 101 . Q:"^1^7^12^13^"[(U_$P(ORIG3,U,3)_U) S NATR=$O(^ORD(100.02,"C","A",0)) 102 . S ^OR(100,ORIG,6)=NATR_U_DUZ_U_ORNOW_"^^Renewal cancelled" 103 . D MSG^ORMBLD(ORIG,"DC") I "^1^13^"'[$P(^OR(100,ORIG,3),U,3) K ^(6) Q 104 . S:'$$ACTV^ORX1(NATR) $P(^OR(100,ORIG,3),U,7)=0 105 Q 106 ; 107 CANCEL(IFN) ; -- Cancel any outstanding actions for order IFN 108 N I S I=0 109 F S I=$O(^OR(100,IFN,8,I)) Q:I'>0 I $P(^(I,0),U,15)=11 S $P(^(0),U,15)=13 D:$P(^(0),U,4)=2 SIGN^ORCSAVE2(IFN,"","",5,I) ; cancelled, sig not reqd now 110 Q 111 ; 112 HD ; -- Hold order ORIFN 113 N STS,ORSAVE I 'ORDA S ORERR="1^Unable to hold" Q 114 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG Q 115 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 116 S ORSAVE=ORIFN D MSG^ORMBLD((ORIFN_";"_ORDA),"HD") S ORIFN=ORSAVE 117 S STS=$P($G(^OR(100,ORIFN,3)),U,3) I STS=3 S $P(^(3),U,7)=ORDA D SET^ORDD100(ORIFN,ORDA) 118 I STS'=3 S ORERR="1^"_$$WHY(ORIFN,ORDA) D:'SIGNED&SIGNREQD NOSIG 119 Q 120 ; 121 RL ; -- Release hold on order ORIFN 122 N STS,ORSAVE,ORHD I 'ORDA S ORERR="1^Unable to release hold" Q 123 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG Q 124 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 125 S ORSAVE=ORIFN D MSG^ORMBLD((ORIFN_";"_ORDA),"RL") S ORIFN=ORSAVE 126 S STS=$P($G(^OR(100,ORIFN,3)),U,3),ORHD=+$P($G(^(3)),U,7) 127 I STS'=3 S $P(^OR(100,ORIFN,3),U,7)=ORDA,$P(^(8,ORHD,2),U,1,2)=ORNOW_U_DUZ D SET^ORDD100(ORIFN,ORDA) 128 I STS=3 S ORERR="1^"_$$WHY(ORIFN,ORDA) D:'SIGNED&SIGNREQD NOSIG 129 Q 130 ; 131 FL ; -- Flag order ORIFN 132 Q 133 ; 134 UF ; -- Unflag order ORIFN 135 Q 136 ; 137 CM ; -- Add Ward comments to order ORIFN 138 Q 139 ; 140 VR ; -- Verify order ORIFN 141 I 'ORDA!(SIGSTS=2) S ORERR="1^Unable to verify" Q 142 I "^N^C^R^"'[(U_$G(ORVER)_U) S ORERR="1^Unable to verify" Q 143 D VERIFY^ORCSAVE2(ORIFN,ORDA,ORVER,DUZ,ORNOW) 144 ; -- send HL7 msg to Pharmacy if Nurse-Verified, [Sts=pending] 145 Q:ORVER'="N" N ORSTS,ORPKG,ORX 146 S ORX=$P($G(^OR(100,ORIFN,8,ORDA,0)),U,2) Q:ORX'="NW"&(ORX'="XX") 147 S ORPKG=+$P($G(^OR(100,ORIFN,0)),U,14),ORSTS=$P($G(^(3)),U,3) 148 ;I ORSTS=5!$L($T(ZV^ORMPS)),$$NMSP^ORCD(ORPKG)="PS" D VER^ORMBLDPS(ORIFN) 149 I $$NMSP^ORCD(ORPKG)="PS" D VER^ORMBLDPS(ORIFN) 150 Q 151 ; 152 NEEDSIG() ; -- Msg 153 Q "1^This order requires a signature." 154 ; 155 WHY(IFN,DA) ; -- Return reason request was rejected 156 N X S X=$G(^OR(100,IFN,8,DA,1)) 157 S:'$L(X) X="Unable to "_$S(ACTION="HD":"hold",ACTION="RL":"release hold",ACTION="DC":"discontinue",ACTION="XX":"change",ACTION="RN":"renew",1:"release") 158 Q X 159 ; 160 NOSIG ; -- Mark order as Sig not Req'd due to cancel/reject 161 D SIGN^ORCSAVE2(ORIFN,"","",5,ORDA) S SIGNREQD=0 162 Q 163 ; 164 READY(IFN,ACT) ; -- Ready to release? 165 N X,Y,OR0,OR3,ORA 166 I ACTION="VR" S Y=1 G RQ ; no action to release 167 I 'ACT,ACTION="DC" S Y=1 G RQ ; cancel a duplicate 168 S Y=0,OR0=$G(^OR(100,IFN,0)),OR3=$G(^(3)),ORA=$G(^(8,ACT,0)) 169 I $P(ORA,U,15)=11 S Y=1 G RQ ; unreleased 170 I $P(ORA,U,15)=10 D G RQ ; delayed 171 . I $G(^DPT(+ORVP,.105)),$$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)="PSO" S Y=1 Q 172 . Q:'RELSTS N ORIG S ORIG=+$P(OR3,U,5) 173 . I 'SIGNED,$L($G(NATURE)) S $P(ORA,U,17)=DUZ,$P(ORA,U,12)=$S(NATURE:NATURE,1:+$O(^ORD(100.02,"C",NATURE,0))),^OR(100,IFN,8,ACT,0)=ORA 174 . Q:$P(OR3,U,11)'=1!('ORIG) ;dc original if signed edit 175 . D STATUS^ORCSAVE2(ORIG,12) 176 . S ^OR(100,ORIG,6)=+$O(^ORD(100.02,"C","C",0))_U_DUZ_U_ORNOW 177 . S $P(^OR(100,ORIG,3),U,7)=0,$P(^(8,1,0),U,15)=12 D:$P($G(^(0)),U,4)=2 SIGN^ORCSAVE2(ORIG,,,5,1) 178 I $P(OR3,U,3)=11,$P(ORA,U,2)="NW" S Y=1 ; Action Sts = "" (old) 179 RQ I +$$SWSTAT^IBBAPI() D:Y=1 EN^ORWPFSS4(+IFN) ; Associate PFSS Account Reference with order, Patch OR*3.0*228 IA #4663 180 Q Y 1 ORCSEND ;SLC/MKB-Release orders ; 08 May 2002 2:12 PM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,27,45,79,92,141,165,195,228**;Dec 17, 1997 3 ; 4 EN(ORIFN,ACTION,SIGSTS,RELSTS,NATURE,REASON,ORERR) ; -- Release [actions on] orders 5 N ORDA,ORNOW,SIGNREQD,SIGNED,SIGNER 6 S SIGNREQD=+$P($G(^OR(100,+ORIFN,0)),U,16),ORERR="" 7 S SIGNED=$S(SIGSTS=2:0,1:1),SIGNER=$S(SIGSTS=1:DUZ,SIGSTS=7:DUZ,1:"") 8 S ORDA=+$P(ORIFN,";",2),ORIFN=+ORIFN,ORNOW=+$E($$NOW^XLFDT,1,12) 9 S:"ES"[$G(ACTION) ACTION=$P($G(^OR(100,ORIFN,8,ORDA,0)),U,2) 10 I SIGNREQD,ORDA,"^NW^RW^XX^RN^DC^HD^RL^"[(U_ACTION_U) D ; sign/alert 11 . I 'SIGNED D NOTIF^ORCSIGN Q 12 . D:SIGSTS'="" SIGN^ORCSAVE2(ORIFN,SIGNER,ORNOW,SIGSTS,ORDA) 13 . D:SIGSTS=4 CHART^ORCSIGN ; not used anymore 14 I '$L(ACTION) S ORERR="1^Invalid order action" Q 15 I $$READY(ORIFN,ORDA) D:$L($T(@ACTION)) @ACTION I 'ORERR,ACTION="NW" D 16 . N OREVT S OREVT=+$P($G(^OR(100,ORIFN,0)),U,17) Q:OREVT<1 17 . I '$$EVTORDER^OREVNTX(ORIFN) D SAVE^ORMEVNT1(ORIFN,OREVT,2,"ES") 18 ; If order originated from the back door, send Dx and TxF back to ancil. 19 I SIGNED,$P($G(^OR(100,+ORIFN,3)),U,11)="P" D BDOEDIT^ORWDBA7 20 Q 21 ; 22 EN1(ORDER,ORERR) ; -- Delayed Release [from RELEASE^ORMEVNT] 23 ; 24 Q:$P($G(^OR(100,+ORDER,3)),U,3)'=10 25 N ORPKG,ORA0,ORNOW,ORIFN,ORDA,ORNP,ORNATR,ORQUIT,ORDUZ,SIGSTS,RELSTS 26 S ORPKG=$P($G(^OR(100,+ORDER,0)),U,14),ORA0=$G(^(8,1,0)) 27 S ORNOW=+$E($$NOW^XLFDT,1,12),ORIFN=+ORDER,ORDA=1,ORNP=$P(ORA0,U,3) 28 S SIGSTS=$P(ORA0,U,4),ORNATR=$P($G(^ORD(100.02,+$P(ORA0,U,12),0)),U,2) 29 S RELSTS=$S(SIGSTS'=2:1,"^V^P^"[(U_ORNATR_U):1,1:0) 30 I RELSTS D 31 . D STARTDT^ORCSAVE2(ORIFN),PKGSTUFF^ORCSEND1(ORPKG) Q:$G(ORQUIT) 32 . S ORDUZ=$S(SIGSTS=0:$P(ORA0,U,7),SIGSTS=1:$P(ORA0,U,5),SIGSTS=2:$P(ORA0,U,17),SIGSTS=3:$P(ORA0,U,13),1:DUZ) 33 . D EDO1^ORWPFSS1 ;PFSS Event Delayed Orders 34 . D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,ORDUZ),NEW^ORMBLD(ORIFN) 35 . I "^10^13^"[(U_$P($G(^OR(100,ORIFN,3)),U,3)_U) S ORERR=1 ;error 36 I 'RELSTS!$G(ORERR),$P($G(^OR(100,ORIFN,3)),U,3)=10 D STATUS^ORCSAVE2(ORIFN,11) S $P(^OR(100,ORIFN,8,1,0),U,15)=11 37 Q 38 ; 39 EN2(ORIFN,SIGSTS,NATURE,ORERR) ; -- Manual Release [from OREVNT1,SENDED^ORWDX] 40 N ORDA,ORNOW,OREVT,ORA0,ORNP,SIGNREQD,SIGNED,RELSTS 41 S ORDA=+$P(ORIFN,";",2),ORIFN=+ORIFN S:ORDA<1 ORDA=1 42 S OREVT=+$P($G(^OR(100,ORIFN,0)),U,17),ORA0=$G(^(8,ORDA,0)) 43 S ORNP=$P(ORA0,U,3),SIGNREQD=($P(ORA0,U,4)'=3),(SIGNED,RELSTS)=1 44 S ORNOW=+$E($$NOW^XLFDT,1,12),ORERR="" 45 I $P(ORA0,U,4)=2 D ;needs ES 46 . N SIGNER S SIGNER=$S(SIGSTS=1:DUZ,1:"") 47 . I SIGSTS=2 D NOTIF^ORCSIGN S SIGNED=0 Q ;still unsigned 48 . D:SIGSTS'="" SIGN^ORCSAVE2(ORIFN,SIGNER,ORNOW,SIGSTS,ORDA) 49 D EDO2^ORWPFSS1 ;PFSS Event Delayed Orders 50 D NW I 'ORERR D SAVE^ORMEVNT1(+ORIFN,OREVT,2,"MN") 51 Q 52 ; 53 NW ; -- New order ORIFN 54 RW ; -- Rewritten order ORIFN 55 XX ; -- Changed order ORIFN 56 RN ; -- Renewed order ORIFN 57 N ORQUIT,STS,TYPE,OR0,OR3,CODE,ORIG,ORSAVE 58 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG,OREBUILD=1 Q 59 S:'ORDA ORDA=1 S ORSAVE=ORIFN 60 S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)) D STARTDT^ORCSAVE2(ORIFN) 61 S TYPE=$P(OR3,U,11),ORIG=+$P(OR3,U,5),CODE="NW" 62 I TYPE=1,ORIG,$D(^OR(100,ORIG,4)) S CODE="XO",^OR(100,ORIG,6)=$O(^ORD(100.02,"C","C",0))_U_DUZ_U_ORNOW 63 D PKGSTUFF^ORCSEND1(+$P(OR0,U,14)) Q:$G(ORQUIT) 64 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 65 D NEW^ORMBLD(ORIFN,CODE) S ORIFN=ORSAVE,STS=$P($G(^OR(100,ORIFN,3)),U,3) 66 I (STS=1)!(STS=13) S ORERR="1^"_$$WHY(ORIFN,1) D:'SIGNED&SIGNREQD NOSIG K:ORIG ^OR(100,ORIG,6) 67 I STS=11 S ORERR="1^ERROR" 68 Q 69 ; 70 DC ; -- DC order ORIFN 71 N PKG,CODE,ORCHLD,ORCHDA,STS,ORIDA,ORSAVE,OR3 72 I '$G(REASON),$G(NATURE)="D" S REASON=+$O(^ORD(100.03,"C","ORDUP",0)) 73 S:$G(REASON) ^OR(100,ORIFN,6)=$S($G(NATURE):NATURE,$L($G(NATURE)):$O(^ORD(100.02,"C",NATURE,0)),1:"")_"^^^"_+REASON_U_$P(^ORD(100.03,+REASON,0),U) 74 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG Q 75 S $P(^OR(100,ORIFN,6),U,2,3)=$S($G(DGPMT):"",1:DUZ)_U_ORNOW,ORSAVE=ORIFN S:'$G(REASON) REASON=$P(^(6),U,4) 76 S STS=$P($G(^OR(100,ORIFN,3)),U,3),PKG=$P($G(^(0)),U,14),PKG=$$NMSP^ORCD(PKG),CODE=$S(PKG="LR":"CA",(PKG="PS")&(STS=5):"CA",(PKG="FH")&(STS=8):"CA",1:"DC") 77 D:ORDA RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 78 DC1 I $O(^OR(100,ORIFN,2,0)) D G DC2 ; DC children 79 . S ORCHLD=0 F S ORCHLD=$O(^OR(100,ORIFN,2,ORCHLD)) Q:ORCHLD'>0 I $$VALID^ORCACT0(ORCHLD,"DC") D Q:$G(ORERR) 80 . . S ORCHDA=$S(ORDA:$$ACTION^ORCSAVE("DC",ORCHLD,ORNP),1:0) 81 . . D:ORCHDA SIGN^ORCSAVE2(ORCHLD,,,"",ORCHDA) ;Sig on Parent only 82 . . D MSG^ORMBLD((ORCHLD_";"_ORCHDA),CODE,$G(REASON)) 83 . . I "^1^13^"'[(U_$P(^OR(100,ORCHLD,3),U,3)_U) S ORERR="1^"_$$WHY(ORCHLD,ORCHDA) 84 . ;D:'$G(ORERR) STATUS^ORCSAVE2(ORIFN,1) 85 . S:$G(ORERR) ^OR(100,ORIFN,8,ORDA,1)=$P(ORERR,U,2) 86 D MSG^ORMBLD((ORIFN_";"_ORDA),CODE,$G(REASON)) 87 DC2 S ORIFN=ORSAVE,OR3=$G(^OR(100,ORIFN,3)),STS=$P(OR3,U,3) 88 I STS'=1,STS'=13,STS'=2 D Q 89 . S ORERR="1^"_$S(ORDA:$$WHY(ORIFN,ORDA),1:"Unable to discontinue") 90 . I ORDA,'SIGNED&SIGNREQD D NOSIG ; sig no longer reqd 91 . K ^OR(100,ORIFN,6) 92 S $P(^OR(100,ORIFN,3),U,7)=$S(ORDA:ORDA,'$$ACTV^ORX1($G(NATURE)):0,1:$P(OR3,U,7)) 93 D CANCEL(ORIFN),SETALL^ORDD100(ORIFN) 94 I $P(OR3,U,11)=2 D ; dc a renewal 95 . N ORIG,ORIG3,NATR S ORIG=$P(OR3,U,5),ORIG3=$G(^OR(100,ORIG,3)) Q:'ORIG 96 . I CODE="CA" S $P(^OR(100,ORIG,3),U,6)="" Q ;pend - remove fwd ptr 97 . Q:"^1^7^12^13^"[(U_$P(ORIG3,U,3)_U) S NATR=$O(^ORD(100.02,"C","A",0)) 98 . S ^OR(100,ORIG,6)=NATR_U_DUZ_U_ORNOW_"^^Renewal cancelled" 99 . D MSG^ORMBLD(ORIG,"DC") I "^1^13^"'[$P(^OR(100,ORIG,3),U,3) K ^(6) Q 100 . S:'$$ACTV^ORX1(NATR) $P(^OR(100,ORIG,3),U,7)=0 101 Q 102 ; 103 CANCEL(IFN) ; -- Cancel any outstanding actions for order IFN 104 N I S I=0 105 F S I=$O(^OR(100,IFN,8,I)) Q:I'>0 I $P(^(I,0),U,15)=11 S $P(^(0),U,15)=13 D:$P(^(0),U,4)=2 SIGN^ORCSAVE2(IFN,"","",5,I) ; cancelled, sig not reqd now 106 Q 107 ; 108 HD ; -- Hold order ORIFN 109 N STS,ORSAVE I 'ORDA S ORERR="1^Unable to hold" Q 110 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG Q 111 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 112 S ORSAVE=ORIFN D MSG^ORMBLD((ORIFN_";"_ORDA),"HD") S ORIFN=ORSAVE 113 S STS=$P($G(^OR(100,ORIFN,3)),U,3) I STS=3 S $P(^(3),U,7)=ORDA D SET^ORDD100(ORIFN,ORDA) 114 I STS'=3 S ORERR="1^"_$$WHY(ORIFN,ORDA) D:'SIGNED&SIGNREQD NOSIG 115 Q 116 ; 117 RL ; -- Release hold on order ORIFN 118 N STS,ORSAVE,ORHD I 'ORDA S ORERR="1^Unable to release hold" Q 119 I SIGNREQD,'SIGNED,'RELSTS S ORERR=$$NEEDSIG Q 120 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,DUZ,$G(NATURE)) 121 S ORSAVE=ORIFN D MSG^ORMBLD((ORIFN_";"_ORDA),"RL") S ORIFN=ORSAVE 122 S STS=$P($G(^OR(100,ORIFN,3)),U,3),ORHD=+$P($G(^(3)),U,7) 123 I STS'=3 S $P(^OR(100,ORIFN,3),U,7)=ORDA,$P(^(8,ORHD,2),U,1,2)=ORNOW_U_DUZ D SET^ORDD100(ORIFN,ORDA) 124 I STS=3 S ORERR="1^"_$$WHY(ORIFN,ORDA) D:'SIGNED&SIGNREQD NOSIG 125 Q 126 ; 127 FL ; -- Flag order ORIFN 128 Q 129 ; 130 UF ; -- Unflag order ORIFN 131 Q 132 ; 133 CM ; -- Add Ward comments to order ORIFN 134 Q 135 ; 136 VR ; -- Verify order ORIFN 137 I 'ORDA!(SIGSTS=2) S ORERR="1^Unable to verify" Q 138 I "^N^C^R^"'[(U_$G(ORVER)_U) S ORERR="1^Unable to verify" Q 139 D VERIFY^ORCSAVE2(ORIFN,ORDA,ORVER,DUZ,ORNOW) 140 ; -- send HL7 msg to Pharmacy if Nurse-Verified, [Sts=pending] 141 Q:ORVER'="N" N ORSTS,ORPKG,ORX 142 S ORX=$P($G(^OR(100,ORIFN,8,ORDA,0)),U,2) Q:ORX'="NW"&(ORX'="XX") 143 S ORPKG=+$P($G(^OR(100,ORIFN,0)),U,14),ORSTS=$P($G(^(3)),U,3) 144 ;I ORSTS=5!$L($T(ZV^ORMPS)),$$NMSP^ORCD(ORPKG)="PS" D VER^ORMBLDPS(ORIFN) 145 I $$NMSP^ORCD(ORPKG)="PS" D VER^ORMBLDPS(ORIFN) 146 Q 147 ; 148 NEEDSIG() ; -- Msg 149 Q "1^This order requires a signature." 150 ; 151 WHY(IFN,DA) ; -- Return reason request was rejected 152 N X S X=$G(^OR(100,IFN,8,DA,1)) 153 S:'$L(X) X="Unable to "_$S(ACTION="HD":"hold",ACTION="RL":"release hold",ACTION="DC":"discontinue",ACTION="XX":"change",ACTION="RN":"renew",1:"release") 154 Q X 155 ; 156 NOSIG ; -- Mark order as Sig not Req'd due to cancel/reject 157 D SIGN^ORCSAVE2(ORIFN,"","",5,ORDA) S SIGNREQD=0 158 Q 159 ; 160 READY(IFN,ACT) ; -- Ready to release? 161 N X,Y,OR0,OR3,ORA 162 I ACTION="VR" S Y=1 G RQ ; no action to release 163 I 'ACT,ACTION="DC" S Y=1 G RQ ; cancel a duplicate 164 S Y=0,OR0=$G(^OR(100,IFN,0)),OR3=$G(^(3)),ORA=$G(^(8,ACT,0)) 165 I $P(ORA,U,15)=11 S Y=1 G RQ ; unreleased 166 I $P(ORA,U,15)=10 D G RQ ; delayed 167 . I $G(^DPT(+ORVP,.105)),$$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)="PSO" S Y=1 Q 168 . Q:'RELSTS N ORIG S ORIG=+$P(OR3,U,5) 169 . I 'SIGNED,$L($G(NATURE)) S $P(ORA,U,17)=DUZ,$P(ORA,U,12)=$S(NATURE:NATURE,1:+$O(^ORD(100.02,"C",NATURE,0))),^OR(100,IFN,8,ACT,0)=ORA 170 . Q:$P(OR3,U,11)'=1!('ORIG) ;dc original if signed edit 171 . D STATUS^ORCSAVE2(ORIG,12) 172 . S ^OR(100,ORIG,6)=+$O(^ORD(100.02,"C","C",0))_U_DUZ_U_ORNOW 173 . S $P(^OR(100,ORIG,3),U,7)=0,$P(^(8,1,0),U,15)=12 D:$P($G(^(0)),U,4)=2 SIGN^ORCSAVE2(ORIG,,,5,1) 174 I $P(OR3,U,3)=11,$P(ORA,U,2)="NW" S Y=1 ; Action Sts = "" (old) 175 RQ I Y=1 D EN^ORWPFSS4(+IFN) ; Associate PFSS Account Reference with order, Patch OR*3.0*228 176 Q Y
Note:
See TracChangeset
for help on using the changeset viewer.
