source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OV1.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1LR7OV1 ;slc/dcm - Update Ordering Parameters ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
3 ;
4PKG() ;Package level parameters
5 S X=$O(^DIC(9.4,"B","LAB SERVICE",0))_";DIC(9.4,"
6 Q X
7 ;
8EN ;Pass Lab parameters to OE/RR
9 N DATA,IFN,X
10 S DATA=($P($G(^LAB(69.9,1,5)),"^",4)=1) D MON(DATA)
11 S DATA=($P($G(^LAB(69.9,1,5)),"^",5)=1) D TUES(DATA)
12 S DATA=($P($G(^LAB(69.9,1,5)),"^",6)=1) D WED(DATA)
13 S DATA=($P($G(^LAB(69.9,1,5)),"^",7)=1) D THURS(DATA)
14 S DATA=($P($G(^LAB(69.9,1,5)),"^",1)=1) D FRI(DATA)
15 S DATA=($P($G(^LAB(69.9,1,5)),"^",2)=1) D SAT(DATA)
16 S DATA=($P($G(^LAB(69.9,1,5)),"^",3)=1) D SUN(DATA)
17 S DATA=$P($G(^LAB(69.9,1,0)),"^",10) D HOL(DATA)
18 S IFN=0 F S IFN=$O(^LAB(69.9,1,4,IFN)) Q:IFN<1 S X=^(IFN,0) D
19 . S DATA=$P(X,"^"),DIV=$P(X,"^",4) D COLTIM(DIV,IFN,$P(X,"^",2))
20 S IFN=0 F S IFN=$O(^LAB(69.9,1,9,IFN)) Q:IFN<1 S X=^(IFN,0) D
21 . D:$P(X,"^",2) MAXDAY($P(X,"^"),1,$P(X,"^",2))
22 . D:$P(X,"^",5) URG($P(X,"^"),1,1)
23 . D:$L($P(X,"^",6)) TYPE($P(X,"^"),1,$P(X,"^",6))
24 S IFN=0 F S IFN=$O(^LAB(69.9,1,2,IFN)) Q:IFN<1 S X=+^(IFN,0) D
25 . D:X EXCEPTED(X,1,1)
26 Q
27MON(DATA) ;Collect Monday orders
28 Q:'$$XPARCK^LR7OV2
29 N X D PUT^XPAR($$PKG,"LR COLLECT MONDAY",1,DATA)
30 Q
31TUES(DATA) ;Collect Tuesday orders in
32 Q:'$$XPARCK^LR7OV2
33 N X D PUT^XPAR($$PKG,"LR COLLECT TUESDAY",1,DATA)
34 Q
35WED(DATA) ;Collect Wednesday order in
36 Q:'$$XPARCK^LR7OV2
37 N X D PUT^XPAR($$PKG,"LR COLLECT WEDNESDAY",1,DATA)
38 Q
39THURS(DATA) ;Collect Thursday order in
40 Q:'$$XPARCK^LR7OV2
41 N X D PUT^XPAR($$PKG,"LR COLLECT THURSDAY",1,DATA)
42 Q
43FRI(DATA) ;Collect Friday orders in
44 Q:'$$XPARCK^LR7OV2
45 N X D PUT^XPAR($$PKG,"LR COLLECT FRIDAY",1,DATA)
46 Q
47SAT(DATA) ;Collect Saturday orders in
48 Q:'$$XPARCK^LR7OV2
49 N X D PUT^XPAR($$PKG,"LR COLLECT SATURDAY",1,DATA)
50 Q
51SUN(DATA) ;Collect Sunday orders in
52 Q:'$$XPARCK^LR7OV2
53 N X D PUT^XPAR($$PKG,"LR COLLECT SUNDAY",1,DATA)
54 Q
55HOL(DATA) ;Ignore holidays
56 Q:'$$XPARCK^LR7OV2
57 N X D PUT^XPAR($$PKG,"LR IGNORE HOLIDAYS",1,DATA)
58 Q
59DIV(DIV) ;Division level parameters
60 S X=$S(DIV:DIV,$D(DUZ(2)):DUZ(2),1:"")_";DIC(4,"
61 Q X
62COLTIM(DIV,ID,DATA) ;Phlebotomy collection time
63 Q:'$$XPARCK^LR7OV2
64 N X
65 N X D PUT^XPAR($$DIV(DIV),"LR PHLEBOTOMY COLLECTION",ID,DATA)
66 Q
67MAXDAY(LOC,ID,DATA) ;Max days for continuous orders
68 Q:'$$XPARCK^LR7OV2
69 N X D PUT^XPAR($$LOC(LOC),"LR MAX DAYS CONTINUOUS",ID,DATA)
70 Q
71LOC(LOC) ;Location level parameters
72 S X=LOC_";SC("
73 Q X
74 ;
75EXCEPTED(LOC,ID,DATA) ;Excepted locations
76 Q:'$$XPARCK^LR7OV2
77 D PUT^XPAR($$LOC(LOC),"LR EXCEPTED LOCATIONS",ID,DATA)
78 Q
79URG(LOC,ID,DATA) ;Ask Urgency
80 Q:'$$XPARCK^LR7OV2
81 N X D PUT^XPAR($$LOC(LOC),"LR ASK URGENCY",ID,DATA)
82 Q
83TYPE(LOC,ID,DATA) ;Default Collection type for quick orders
84 Q:'$$XPARCK^LR7OV2
85 N X D PUT^XPAR($$LOC(LOC),"LR DEFAULT TYPE QUICK",ID,DATA)
86 Q
Note: See TracBrowser for help on using the repository browser.