- 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/ORWOR.m
r613 r623 1 ORWOR ; SLC/KCM - Orders Calls;10:54 PM 08/15/20062 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,141,163,187,190,215,243**;Dec 17, 1997;Build 242 3 4 CURRENT(LST,DFN) 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 DETAIL(LST,ORID,DFN) 22 23 24 25 26 27 28 29 RESULT(REF,DFN,ORID,ID) 30 31 32 33 34 35 36 RESHIST(REF,DFN,ORID,ID) 37 38 39 40 41 42 43 44 TSALL(LST) 45 46 47 48 DT(X) 49 50 51 VWSET(ORERR,VIEW) 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 VWGET(REC) 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 SHEETS(LST,ORVP) 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 EVENTS(LST,EVT) 109 110 111 112 113 114 115 UNSIGN(LST,ORVP,HAVE) 116 117 118 119 120 121 122 123 124 125 126 127 128 . . . S ILST=ILST+1,LST(ILST)=IFN_";"_ACT_U_$P(X8,U,3) 129 130 PKIUSE(RETURN) 131 132 133 134 PKISITE(RETURN) 135 136 137 138 139 140 ACTXT(ORY,ORIFN) 141 142 143 144 145 146 147 148 EXPIRED(ORY) 149 150 151 152 1 ORWOR ; SLC/KCM - Orders Calls;10:54 PM 02 Feb 2003 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,141,163,187,190,215**;Dec 17, 1997 3 ; 4 CURRENT(LST,DFN) ; Get Current Orders for a Patient 5 ; Returns two lists in ^TMP("ORW",$J), fields and text 6 N TM,IEN,X,X0,X3,CTR,IDX,I 7 K ^TMP("ORW",$J) 8 S IDX=0,DFN=DFN_";DPT(" 9 S TM=0 F S TM=$O(^OR(100,"AC",DFN,TM)) Q:TM<1 D 10 . S IEN=0 F S IEN=$O(^OR(100,"AC",DFN,TM,IEN)) Q:IEN<1 D 11 . . S X0=^OR(100,IEN,0),X3=^(3) 12 . . S X=IEN_U_$P(X0,U,7)_U_$P(X0,U,11)_U_$P(X3,U,6)_U_$P(X3,U,3) 13 . . S ^TMP("ORW",$J,IDX+1)=X 14 . . S (CTR,I)=0,X="" 15 . . F S I=$O(^OR(100,IEN,1,I)) Q:I<1 D Q:CTR>244 16 . . . S X=X_$E(^OR(100,IEN,1,I,0),1,(245-CTR)),CTR=$L(X) 17 . . S ^TMP("ORW",$J,IDX+2)=X,IDX=IDX+2 18 ; S LST=$NA(^TMP("ORW",$J)) 19 M LST=^TMP("ORW",$J) 20 Q 21 DETAIL(LST,ORID,DFN) ; Return details of ORID (shell to kill VIDEO subs) 22 Q:'+ORID 23 I $G(DFN) N ORVP S ORVP=DFN_";DPT(" 24 S LST="^TMP(""ORTXT"",$J)" 25 D DETAIL^ORQ2(.LST,ORID) 26 K @LST@("VIDEO") 27 S LST=$NA(^TMP("ORTXT",$J)),@LST="" 28 Q 29 RESULT(REF,DFN,ORID,ID) ; Return results of order identified by ID 30 K ^TMP("ORXPND",$J) 31 N ORESULTS,ORVP,LCNT S ORESULTS=1,LCNT=0,ORVP=DFN_";DPT(" 32 D ORDERS^ORCXPND1 33 K ^TMP("ORXPND",$J,"VIDEO") 34 S REF=$NA(^TMP("ORXPND",$J)) 35 Q 36 RESHIST(REF,DFN,ORID,ID) ; Return result history of associated tests identified by ID 37 K ^TMP("ORXPND",$J) 38 N ORESULTS,ORVP,LCNT 39 S ORESULTS=1,LCNT=0,ORVP=DFN_";DPT(" 40 D ORDHIST^ORWOR2 41 K ^TMP("ORXPND",$J,"VIDEO") 42 S REF=$NA(^TMP("ORXPND",$J)) 43 Q 44 TSALL(LST) ; Return list of treating specialties 45 N Y S Y=0 46 F S Y=$O(^DIC(45.7,Y)) Q:'Y I $$ACTIVE^DGACT(45.7,Y) S LST(Y)=Y_U_$P(^DIC(45.7,Y,0),U) 47 Q 48 DT(X) ; -- Returns FM date for X (SEE ORCHTAB1) 49 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT 50 Q +Y 51 VWSET(ORERR,VIEW) ; Set the preferred view for orders 52 ; VIEW: semi-colon delimited record 53 ; 1 - Relative From Date/Time or "" 54 ; 2 - Relative Thru Date/Time or "" 55 ; 3 - Filter 56 ; 4 - Display Group Pointer 57 ; 5 - Format (preserve for list manager) 58 ; 6 - chronological display (R or F) 59 ; 7 - sort by display group 60 N FMT 61 ; use short name for display group instead of pointer 62 I $E($P(VIEW,";",2))="T" S $P(VIEW,";",2)=$P($P(VIEW,";",2),"@") ;allows all orders for Today 63 S $P(VIEW,";",4)=$P($G(^ORD(100.98,+$P(VIEW,";",4),0)),U,3) 64 ; use last saved format, since this is used only by LM 65 S FMT=$P($$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I"),";",5) 66 S:'$L(FMT) FMT="L" S $P(VIEW,";",5)=FMT 67 ; and save the parameter 68 D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT ORDERS",1,VIEW,.ORERR) 69 Q 70 VWGET(REC) ; Get the preferred view for orders 71 N FROM,THRU,FILTER,DGRP,FRMT,CHRN,BYGRP,S,VNAME,FL 72 S REC=$$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I"),S=";" 73 S FROM=$$DT($P(REC,S)),THRU=$$DT($P(REC,S,2)),FILTER=$P(REC,S,3) 74 S DGRP=$P(REC,S,4),FRMT=$P(REC,S,5),CHRN=$P(REC,S,6),BYGRP=$P(REC,S,7) 75 S:'$L(DGRP) DGRP="ALL" S DGRP=+$O(^ORD(100.98,"B",DGRP,0)) 76 I FILTER="" S FILTER=2 ; active orders 77 I CHRN="" S CHRN="R" ; reverse chronological 78 I BYGRP="" S BYGRP=1 ; sort by display group 79 ; set up view name 80 D REVSTS^ORWORDG(.FL) 81 S I=0 F S I=$O(FL(I)) Q:'I Q:+FL(I)=FILTER 82 S VNAME=$P($G(FL(+I)),U,2) 83 I '("^6^8^9^10^19^20^"[(U_FILTER_U)) S VNAME=VNAME_" Orders" 84 I FILTER=2 S VNAME="Active Orders (includes Pending & Recent Activity)" 85 I FILTER=23 S VNAME="Current Orders (Active & Pending Status Only)" 86 S VNAME=VNAME_" - "_$P($G(^ORD(100.98,DGRP,0)),U) 87 I (FROM>0)!(THRU>0) D 88 . S VNAME=VNAME_" ("_$$FMTE^XLFDT(FROM,"2D")_" thru " 89 . S VNAME=VNAME_$S(THRU>0:$$FMTE^XLFDT(THRU,"2D"),1:"")_")" 90 S REC=FROM_S_THRU_S_FILTER_S_DGRP_S_FRMT_S_CHRN_S_BYGRP_S_VNAME 91 Q 92 SHEETS(LST,ORVP) ; Return Order Sheets for a patient 93 N ELST,ETYP,ORIFN,TS,I 94 S ORVP=ORVP_";DPT(" 95 S ETYP="" F S ETYP=$O(^OR(100,"AEVNT",ORVP,ETYP)) Q:ETYP="" D 96 . S ORIFN=0 F S ORIFN=$O(^OR(100,"AEVNT",ORVP,ETYP,ORIFN)) Q:'ORIFN D 97 . . I (ETYP="A")!(ETYP="T") S ELST(ETYP,$P($G(^OR(100,+ORIFN,0)),U,13))="" 98 S LST(1)="C;O^Current View",I=1 99 S TS="" F S TS=$O(ELST("A",TS)) Q:TS="" D 100 . S I=I+1,LST(I)="A;"_TS_U_"Admit to "_$P($G(^DIC(45.7,TS,0)),U) 101 S I=I+1,LST(I)="A;-1^Admit..." 102 S TS="" F S TS=$O(ELST("T",TS)) Q:TS="" D 103 . S I=I+1,LST(I)="T;"_TS_U_"Transfer to "_$P($G(^DIC(45.7,TS,0)),U) 104 I $L($G(^DPT(+ORVP,.1))) D 105 . S I=I+1,LST(I)="T;-1^Transfer..." 106 . S I=I+1,LST(I)="D;0^Discharge" 107 Q 108 EVENTS(LST,EVT) ; Return general delayed events categories for a patient 109 N EVTI 110 S EVTI=0 111 S EVTI=EVTI+1,LST(EVTI)="A;-1^Admit..." 112 S EVTI=EVTI+1,LST(EVTI)="T;-1^Transfer..." 113 S EVTI=EVTI+1,LST(EVTI)="D;0^Discharge" 114 Q 115 UNSIGN(LST,ORVP,HAVE) ; Return Unsigned Orders that are not on client 116 N IFN,ACT,X8,ENT,LVL,TM,ILST S ILST=0 117 Q:'$D(^XUSEC("ORES",DUZ)) 118 S ORVP=ORVP_";DPT(" 119 S ENT="ALL"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"") 120 S LVL=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT") 121 Q:'LVL 122 S TM=0 F S TM=$O(^OR(100,"AS",ORVP,TM)) Q:TM<1 D 123 . S IFN=0 F S IFN=$O(^OR(100,"AS",ORVP,TM,IFN)) Q:IFN<1 D 124 . . S ACT=0 F S ACT=$O(^OR(100,"AS",ORVP,TM,IFN,ACT)) Q:ACT<1 D 125 . . . Q:$D(HAVE(IFN_";"_ACT)) ;in Changes 126 . . . S X8=$G(^OR(100,IFN,8,ACT,0)) 127 . . . I '$S(LVL=1&($P(X8,U,3)=DUZ):1,LVL=2:1,1:0) Q ;chk user 128 . . . S ILST=ILST+1,LST(ILST)=IFN_";"_ACT 129 Q 130 PKIUSE(RETURN) ; RPC determines user can use PKI Digital Signature 131 S RETURN=0 132 I $$GET^XPAR("ALL^USR.`"_DUZ,"ORWOR PKI USE",1,"Q") S RETURN=1 133 Q 134 PKISITE(RETURN) ; RPC determines if PKI is turned on at the site 135 S RETURN=0 136 Q:'$L($T(STORESIG^XUSSPKI)) ;Check for Kernel piece 137 Q:'$L($T(DOSE^PSSOPKI1)) ;Check for Pharmacy piece 138 I $$GET^XPAR("ALL","ORWOR PKI SITE",1,"Q") S RETURN=1 139 Q 140 ACTXT(ORY,ORIFN) ;Return detail action information 141 N ORI,CNT,OR0,OR3,OR6 142 K ^TMP("ORACTXT",$J) 143 S ORY="^TMP(""ORACTXT"",$J)",ORI=$P(ORIFN,";",2) 144 S CNT=0,ORIFN=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)) 145 F S ORI=$O(^OR(100,+ORIFN,8,ORI)) Q:ORI'>0 S ACTION=$G(^(ORI,0)) D ACT^ORQ20 146 S ORY=$NA(^TMP("ORACTXT",$J)),@ORY="" 147 Q 148 EXPIRED(ORY) ;return FM date/time to begin search for expired orders 149 N HRS 150 S HRS=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I") 151 S ORY=$$FMADD^XLFDT($$NOW^XLFDT,"","-"_HRS,"","") 152 Q
Note:
See TracChangeset
for help on using the changeset viewer.
