- 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/ORCFLAG.m
r613 r623 1 ORCFLAG ; SLC/MKB - Flag orders ;12/26/20062 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,243**;Dec 17, 1997;Build 242 3 4 EN1(ORIFN) 5 6 7 8 9 10 11 12 13 14 15 16 EN 17 18 19 20 21 22 23 24 25 26 27 28 UN 29 30 31 32 33 34 35 36 37 38 39 SHOWFLAG 40 41 42 43 44 45 46 REASON() 47 48 49 50 51 52 53 COMMENT() 54 55 56 57 58 59 60 PROV(ORDR) 61 62 63 64 65 66 67 68 BULLETIN 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 LTIM(X) 87 88 89 90 91 92 MSG(ORDER) 93 94 95 96 97 Q:"^PSJ^PSIV^PSO^"'[(U_$$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)_U) ;Inpt or IV98 99 100 101 102 103 104 105 106 1 ORCFLAG ; SLC/MKB - Flag orders ;6/2/97 10:44 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997 3 ; 4 EN1(ORIFN) ; -- standalone entry point to un/flag order ORIFN 5 N ORLK,ORERR,VA,VADM,VAERR,DFN,ORVP,ORPNM,ORSSN,ORAGE,ORACTN,ORPS 6 Q:'$G(ORIFN) S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1" 7 S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2),DFN=+ORVP I 'ORVP!'$D(^(8,+$P(ORIFN,";",2),0)) W !,"Missing or invalid order!" H 1 Q 8 D DEM^VADPT S ORPNM=VADM(1),ORSSN=$P(VADM(2),U,2),ORAGE=VADM(4) 9 S ORACTN=$S($G(^OR(100,+ORIFN,8,+$P(ORIFN,";",2),3)):"UF",1:"FL") 10 I '$$VALID^ORCACT0(ORIFN,ORACTN,.ORERR) W !,ORERR H 1 Q 11 S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !,$P(ORLK,U,2) H 1 Q 12 S ORACTN=$S(ORACTN="UF":"UN",1:"EN"),ORPS=1 13 D @ORACTN,UNLK1^ORX2(+ORIFN) 14 Q 15 ; 16 EN ; -- Flag order ORIFN 17 N OREASON,DA,ORB,ORNP,ORNOW S ORNOW=+$E($$NOW^XLFDT,1,12) 18 S DA=$P(ORIFN,";",2) I 'DA W !,"Unable to flag!" H 1 Q 19 S OREASON=$$REASON Q:OREASON="^" 20 S ORNP=+$P($G(^OR(100,+ORIFN,8,DA,0)),U,3),ORNP=$$PROV(ORNP) Q:ORNP="^" 21 D BULLETIN ;use ORNP? 22 K ^OR(100,+ORIFN,8,DA,3) S ^(3)="1^"_$G(XMZ)_U_ORNOW_U_DUZ_U_OREASON_"^^^^"_ORNP 23 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT,OREBUILD=1 ; Last Activity 24 S ORB=+ORVP_U_+ORIFN_U_ORNP_"^1" D EN^OCXOERR(ORB) ; notification 25 W !?10,"... order flagged." H 1 D KILL^XM,MSG(ORIFN) 26 Q 27 ; 28 UN ; -- Unflag order ORIFN 29 N OREASON,DA,ORB,ORNP,ORNOW S ORNOW=+$E($$NOW^XLFDT,1,12) 30 S DA=$P(ORIFN,";",2) I 'DA W !,"Unable to unflag order!" H 1 Q 31 D SHOWFLAG S OREASON=$$COMMENT Q:OREASON="^" 32 S $P(^OR(100,+ORIFN,8,DA,3),U)=0,$P(^(3),U,6,8)=ORNOW_U_DUZ_U_OREASON 33 S ORNP=+$P(^OR(100,+ORIFN,8,DA,3),U,9) S:'ORNP ORNP=+$P($G(^(0)),U,3) 34 S ORB=+ORVP_U_+ORIFN_U_ORNP_"^0" D EN^OCXOERR(ORB) ; notification 35 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT,OREBUILD=1 ; Last Activity 36 W !?10,"... order unflagged." H 1 D MSG(ORIFN) 37 Q 38 ; 39 SHOWFLAG ; -- Display [last] flag for order ORIFN 40 N FLAG 41 S FLAG=$G(^OR(100,+ORIFN,8,DA,3)) 42 W !," FLAGGED: "_$$LTIM($P(FLAG,U,3))_" by "_$P($G(^VA(200,+$P(FLAG,U,4),0)),U) 43 W !?10,$P(FLAG,U,5) ; reason 44 Q 45 ; 46 REASON() ; -- Reason for flag 47 N X,Y,DIR 48 S DIR(0)="FA^1:80",DIR("A")="REASON FOR FLAG: " ; ck E3R 49 S DIR("?")="A reason must be entered to flag this order." 50 D ^DIR 51 Q Y 52 ; 53 COMMENT() ; -- Comments on unflag 54 N X,Y,DIR 55 S DIR(0)="FAO^1:80",DIR("A")="COMMENTS: " 56 S DIR("?")="A comment may be entered to clarify this order." 57 D ^DIR S:$D(DTOUT) Y="^" 58 Q Y 59 ; 60 PROV(ORDR) ; -- Get provider to alert 61 N X,Y,DIC 62 S DIC=200,DIC(0)="AEQM",DIC("A")="Send alert to: " 63 I $G(ORDR) S ORDR=$P($G(^VA(200,+ORDR,0)),U) S:$L(ORDR) DIC("B")=ORDR 64 S DIC("S")="N ORT S ORT=$P(^(0),U,11) I 'ORT!(ORT>DT)" 65 D ^DIC S:Y>0 Y=+Y I Y'>0 S Y="^" 66 Q Y 67 ; 68 BULLETIN ; -- Send bulletin re: flag 69 N OR0,OR3,ORDTXT,XMB,XMY,XMDUZ,ORENT,BULL,ORSRV,ORUSR 70 S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)) ;ORUSR=+$P(OR0,U,4) 71 S ORUSR=+$G(ORNP),ORSRV=+$P($G(^VA(200,ORUSR,5)),U) 72 S ORENT="USR.`"_ORUSR_"^SRV.`"_ORSRV_"^DIV^SYS^PKG" 73 S BULL=$$GET^XPAR(ORENT,"ORB FLAGGED ORDERS BULLETIN",1,"Q") 74 Q:$G(BULL)'="Y" ;quit if parameter value is not 'Y'es 75 ; 76 W !,"Sending bulletin to "_$P($G(^VA(200,ORUSR,0)),U)_"..." 77 S XMB="OR FLAGGED ORDER",XMDUZ=DUZ,XMY(ORUSR)="" 78 S XMB(1)=ORPNM,XMB(2)=ORSSN,XMB(3)=ORAGE,XMB(4)=$$LTIM($P(OR0,U,7)) 79 D TEXT^ORQ12(.ORDTXT,+ORIFN,80) 80 S XMB(5)=$G(ORDTXT(1)),XMB(6)=$G(ORDTXT(2)),XMB(7)=$G(ORDTXT(3)) 81 S XMB(8)=$$LTIM($P(OR0,U,8)),XMB(9)=$$LTIM($P(OR0,U,9)),XMB(10)=OREASON 82 S XMB(11)=$P($G(^ORD(100.01,+$P(OR3,U,3),0)),U) 83 D EN^XMB 84 Q 85 ; 86 LTIM(X) ; -- format FM date/time into MM/DD HH:MM 87 N Y S Y="" 88 S:X Y=$E(X,4,5)_"/"_$E(X,6,7) 89 S:X["." Y=Y_" "_$E(X_"0",9,10)_":"_$E(X_"000",11,12) 90 Q Y 91 ; 92 MSG(ORDER) ; -- Sends HL7 message to Pharmacy when order is un/flagged 93 Q:'$L($T(OBR^PSJHL4)) ;needs PSJ*5*85 94 Q:'$G(ORDER) Q:'$D(^OR(100,+ORDER,0)) Q:'$P(ORDER,";",2) 95 N OR0,OR3,ORMSG,ORVP,ORX,ORFLAG 96 S OR0=$G(^OR(100,+ORDER,0)),OR3=$G(^(8,+$P(ORDER,";",2),3)) 97 Q:"^PSJ^PSIV^"'[(U_$$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)_U) ;Inpt or IV 98 S ORMSG(1)=$$MSH^ORMBLD("ORU","PS") 99 S ORVP=$P(OR0,U,2),ORMSG(2)=$$PID^ORMBLD(ORVP) 100 S ORMSG(3)=$$PV1^ORMBLD(ORVP,$P(OR0,U,12),+$P(OR0,U,10)) 101 S ORX=$S(OR3:$P(OR3,U,3,5),1:$P(OR3,U,6,8)) 102 S ORFLAG=$S(OR3:"FL",1:"UF")_"|||"_$$HL7DATE^ORMBLD($P(ORX,U))_"||||||"_$P(ORX,U,3)_"|||"_+$P(ORX,U,2) 103 S:$G(ORPS) ORFLAG=ORFLAG_"||||||||PHR" ;action taken by pharmacist 104 S ORMSG(4)="OBR|1|"_ORDER_"^OR|"_$G(^OR(100,+ORDER,4))_"^PS|"_ORFLAG 105 D MSG^XQOR("OR EVSEND PS",.ORMSG) 106 Q
Note:
See TracChangeset
for help on using the changeset viewer.
