- 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/ORWDLR33.m
r613 r623 1 ORWDLR33 ; SLC/KCM/REV/JDL - Lab Calls ; 7/1/2002 11AM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,141,243**;Dec 17, 1997;Build 242 3 ; 4 STOP(VAL,X2) ; return a calculated stop date 5 N X1,X 6 S X1=DT D C^%DTC S VAL=X 7 Q 8 MAXDAYS(Y,LOC,SCHED) ; Return max number of days for a continuing order 9 N TMP1,TMP2 10 K ^TMP($J,"ORWDLR33 MAXDAYS") 11 S TMP1=$$GET^XPAR("ALL^LOC.`"_+LOC,"LR MAX DAYS CONTINUOUS",1,"Q") 12 I +TMP1=0 S Y="-1" Q 13 I +$G(SCHED)>0 D ZERO^PSS51P1(SCHED,,,,"ORWDLR33 MAXDAYS") S TMP2=$G(^TMP($J,"ORWDLR33 MAXDAYS",SCHED,2.5)) K ^TMP($J,"ORWDLR33 MAXDAYS") 14 E S TMP2=0 15 I +TMP1=0,+TMP2>0 S Y=TMP2 Q 16 I +TMP2=0,+TMP1>0 S Y=TMP1 Q 17 S Y=$S(+TMP1>+TMP2:+TMP2,+TMP2>+TMP1:+TMP1,+TMP1=+TMP2:+TMP1,1:0) 18 K ^TMP($J,"ORWDLR33 MAXDAYS") 19 Q 20 ALLSPEC(Y,FROM,DIR) ; Return a set of specimens from topography file 21 N I,IEN,CNT S I=0,CNT=44 22 F Q:I'<CNT S FROM=$O(^LAB(61,"B",FROM),DIR) Q:FROM="" D 23 . S IEN=0 F S IEN=$O(^LAB(61,"B",FROM,IEN)) Q:'IEN D 24 . . S I=I+1,Y(I)=IEN_U_FROM_" ("_$P($G(^LAB(61,IEN,0)),U,2)_")" 25 Q 26 LABCOLTM(ORYN,ORDATE,ORLOC) ; Is this a routine lab collect time for this location? 27 N ORDA,ORTI,ORDOW,ORCTM,I,X,Y 28 S ORYN=0 Q:'$G(ORDATE)!($G(ORDATE)<0)!('$G(ORLOC)) 29 S ORDA=$P(ORDATE,".",1),ORTI=$P(ORDATE,".",2) 30 S I=0 F S I=$L(ORTI) Q:I>3 S ORTI=ORTI_"0" 31 S X=ORDA D DW^%DTC S ORDOW=X 32 D GETLST^XPAR(.ORCTM,"ALL","LR PHLEBOTOMY COLLECTION","Q") 33 S I=0 F S I=$O(ORCTM(I)) Q:'I D 34 . S:$P(ORCTM(I),U,2)=ORTI ORYN=1 35 Q:ORYN=0 36 I $G(ORLOC),$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") S ORYN=1 Q 37 I '$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(ORDA,0)) S ORYN=0 Q 38 I $$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q") S ORYN=1 Q 39 S ORYN=0 40 Q 41 IMMCOLL(ORY) ; Return help screen showing immediate collect times 42 D SHOW^LR7OV4(DUZ(2),.ORY) 43 Q 44 ICDEFLT(ORY) ;Return default immediate collect time 45 S ORY=$$DEFTIME^LR7OV4(DUZ(2)) 46 Q 47 ICVALID(ORY,ORTIME) ;Is the time a valid immediate collect time? 48 S ORTIME=$P(ORTIME,".",1)_"."_$E($P(ORTIME,".",2),1,4) 49 S ORY=$$VALID^LR7OV4(DUZ(2),ORTIME) 50 Q 51 GETLABTM(ORY,ORDATE,ORLOC) ;Return list of lab collect times for a date and location 52 N ORDA,ORTI,ORNOW,ORDOW,ORCTM,ORTI,X,%,%H 53 S ORY(0)=0 Q:'$G(ORDATE)!($G(ORDATE)<0)!('$G(ORLOC)) 54 S ORDA=$P(ORDATE,".",1) 55 S ORNOW=$$NOW^XLFDT,ORTI=$P(ORNOW,".",2) 56 I ORDA<$P(ORNOW,".",1) S ORY(0)="-1^Dates in the past are not allowed." Q 57 I '+$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") D 58 . S X=ORDA D DW^%DTC S ORDOW=X 59 . I '+$$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q") S ORY(0)="-1^No collections on "_ORDOW Q 60 . I '+$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(ORDA,0)) S ORY(0)="-1^No holiday collections" Q 61 I +ORY(0)>-1 D 62 . D GETLST^XPAR(.ORY,"ALL","LR PHLEBOTOMY COLLECTION","Q") 63 . I +$G(ORY)=0 S ORY(0)="-1^No lab collect times defined for this division" Q 64 S I=0 F S I=$O(ORY(I)) Q:'I D 65 . D NOW^%DTC S ORTI=%,%H=+%H_","_+ORY(I) D YMD^%DTC 66 . I (ORDA=$P(ORTI,".",1)),(+(ORDA+%)<+ORTI) K ORY(I) S ORY=ORY-1 Q ; cutoff time has passed for this collect time 67 . S ORY(I)=$P(ORY(I),U,2) 68 I +$G(ORY)=0,('$D(ORY(0))) S ORY(0)="-1^All of today's collection times have passed." 69 Q 70 LCFUTR(ORDY,ORLOC,ORDIV) ;Get # of days for future Lab Collects 71 ; For Event Delay Order 72 ; --ORLOC Event default location 73 ; --ORDIV Event default division 74 S ORDY=0 75 Q:'$D(^XTV(8989.51,"B","LR LAB COLLECT FUTURE")) 76 I $G(ORDIV) S ORDY=+$$GET^XPAR(+$G(ORLOC)_";SC("_"^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","LR LAB COLLECT FUTURE",1,"I") 77 E S ORDY=+$$GET^XPAR(+$G(ORLOC)_";SC("_"^DIV^SYS^PKG","LR LAB COLLECT FUTURE",1,"I") 78 ;S DUZ(2)=TMPDIV 79 Q 80 LASTTIME(ORY) ; Get last collection time used from ^TMP("ORECALL",$J) array 81 N ORDIALOG,ORTYPE,ORTIME 82 S ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB TESTS",0)) 83 S ORTYPE=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0)) 84 S ORTIME=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 85 S ORY=$$RECALL^ORCD(ORTYPE,1)_U_$$RECALL^ORCD(ORTIME,1) 86 Q 87 LCTOWC(ORTXT,ORLOC) ; return text instructing user when LC changed to WC on accept/release 88 N ORDIV,ORSVC 89 S ORDIV=DUZ(2) 90 S ORSVC=+$G(^VA(200,DUZ,5)) 91 I ORSVC S ORTXT=$$GET^XPAR(+$G(ORLOC)_";SC("_"^"_+$G(ORSVC)_";DIC(49,^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","ORWLR LC CHANGED TO WC",1,"I") 92 E S ORTXT=$$GET^XPAR(+$G(ORLOC)_";SC("_"^SVC^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","ORWLR LC CHANGED TO WC",1,"I") 93 Q 1 ORWDLR33 ; SLC/KCM/REV/JDL - Lab Calls ; 7/1/2002 11AM 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,141**;Dec 17, 1997 3 ; 4 STOP(VAL,X2) ; return a calculated stop date 5 N X1,X 6 S X1=DT D C^%DTC S VAL=X 7 Q 8 MAXDAYS(Y,LOC,SCHED) ; Return max number of days for a continuing order 9 N TMP1,TMP2 10 S TMP1=$$GET^XPAR("ALL^LOC.`"_+LOC,"LR MAX DAYS CONTINUOUS",1,"Q") 11 I +TMP1=0 S Y="-1" Q 12 I +$G(SCHED)>0 S TMP2=$P($G(^PS(51.1,SCHED,0)),U,7) 13 E S TMP2=0 14 I +TMP1=0,+TMP2>0 S Y=TMP2 Q 15 I +TMP2=0,+TMP1>0 S Y=TMP1 Q 16 S Y=$S(+TMP1>+TMP2:+TMP2,+TMP2>+TMP1:+TMP1,+TMP1=+TMP2:+TMP1,1:0) 17 Q 18 ALLSPEC(Y,FROM,DIR) ; Return a set of specimens from topography file 19 N I,IEN,CNT S I=0,CNT=44 20 F Q:I'<CNT S FROM=$O(^LAB(61,"B",FROM),DIR) Q:FROM="" D 21 . S IEN=0 F S IEN=$O(^LAB(61,"B",FROM,IEN)) Q:'IEN D 22 . . S I=I+1,Y(I)=IEN_U_FROM_" ("_$P($G(^LAB(61,IEN,0)),U,2)_")" 23 Q 24 LABCOLTM(ORYN,ORDATE,ORLOC) ; Is this a routine lab collect time for this location? 25 N ORDA,ORTI,ORDOW,ORCTM,I,X,Y 26 S ORYN=0 Q:'$G(ORDATE)!($G(ORDATE)<0)!('$G(ORLOC)) 27 S ORDA=$P(ORDATE,".",1),ORTI=$P(ORDATE,".",2) 28 S I=0 F S I=$L(ORTI) Q:I>3 S ORTI=ORTI_"0" 29 S X=ORDA D DW^%DTC S ORDOW=X 30 D GETLST^XPAR(.ORCTM,"ALL","LR PHLEBOTOMY COLLECTION","Q") 31 S I=0 F S I=$O(ORCTM(I)) Q:'I D 32 . S:$P(ORCTM(I),U,2)=ORTI ORYN=1 33 Q:ORYN=0 34 I $G(ORLOC),$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") S ORYN=1 Q 35 I '$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(ORDA,0)) S ORYN=0 Q 36 I $$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q") S ORYN=1 Q 37 S ORYN=0 38 Q 39 IMMCOLL(ORY) ; Return help screen showing immediate collect times 40 D SHOW^LR7OV4(DUZ(2),.ORY) 41 Q 42 ICDEFLT(ORY) ;Return default immediate collect time 43 S ORY=$$DEFTIME^LR7OV4(DUZ(2)) 44 Q 45 ICVALID(ORY,ORTIME) ;Is the time a valid immediate collect time? 46 S ORTIME=$P(ORTIME,".",1)_"."_$E($P(ORTIME,".",2),1,4) 47 S ORY=$$VALID^LR7OV4(DUZ(2),ORTIME) 48 Q 49 GETLABTM(ORY,ORDATE,ORLOC) ;Return list of lab collect times for a date and location 50 N ORDA,ORTI,ORNOW,ORDOW,ORCTM,ORTI,X,%,%H 51 S ORY(0)=0 Q:'$G(ORDATE)!($G(ORDATE)<0)!('$G(ORLOC)) 52 S ORDA=$P(ORDATE,".",1) 53 S ORNOW=$$NOW^XLFDT,ORTI=$P(ORNOW,".",2) 54 I ORDA<$P(ORNOW,".",1) S ORY(0)="-1^Dates in the past are not allowed." Q 55 I '+$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") D 56 . S X=ORDA D DW^%DTC S ORDOW=X 57 . I '+$$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q") S ORY(0)="-1^No collections on "_ORDOW Q 58 . I '+$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(ORDA,0)) S ORY(0)="-1^No holiday collections" Q 59 I +ORY(0)>-1 D 60 . D GETLST^XPAR(.ORY,"ALL","LR PHLEBOTOMY COLLECTION","Q") 61 . I +$G(ORY)=0 S ORY(0)="-1^No lab collect times defined for this division" Q 62 S I=0 F S I=$O(ORY(I)) Q:'I D 63 . D NOW^%DTC S ORTI=%,%H=+%H_","_+ORY(I) D YMD^%DTC 64 . I (ORDA=$P(ORTI,".",1)),(+(ORDA+%)<+ORTI) K ORY(I) S ORY=ORY-1 Q ; cutoff time has passed for this collect time 65 . S ORY(I)=$P(ORY(I),U,2) 66 I +$G(ORY)=0,('$D(ORY(0))) S ORY(0)="-1^All of today's collection times have passed." 67 Q 68 LCFUTR(ORDY,ORLOC,ORDIV) ;Get # of days for future Lab Collects 69 ; For Event Delay Order 70 ; --ORLOC Event default location 71 ; --ORDIV Event default division 72 S ORDY=0 73 Q:'$D(^XTV(8989.51,"B","LR LAB COLLECT FUTURE")) 74 I $G(ORDIV) S ORDY=+$$GET^XPAR(+$G(ORLOC)_";SC("_"^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","LR LAB COLLECT FUTURE",1,"I") 75 E S ORDY=+$$GET^XPAR(+$G(ORLOC)_";SC("_"^DIV^SYS^PKG","LR LAB COLLECT FUTURE",1,"I") 76 ;S DUZ(2)=TMPDIV 77 Q 78 LASTTIME(ORY) ; Get last collection time used from ^TMP("ORECALL",$J) array 79 N ORDIALOG,ORTYPE,ORTIME 80 S ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB TESTS",0)) 81 S ORTYPE=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0)) 82 S ORTIME=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 83 S ORY=$$RECALL^ORCD(ORTYPE,1)_U_$$RECALL^ORCD(ORTIME,1) 84 Q
Note:
See TracChangeset
for help on using the changeset viewer.
