source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDCSLT.m@ 1141

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1ORWDCSLT ; SLC/KCM - Consults calls [ 08/04/96 7:36 PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 ;
4DEF(LST) ; load consult info
5 N ILST,NAM,IEN,X
6 S ILST=0
7 S LST($$NXT)="~Services" D SRVC
8 S LST($$NXT)="~Inpt Urgencies" D INURG
9 S LST($$NXT)="~Outpt Urgencies" D OUTURG
10 S LST($$NXT)="~Inpt Place" D INPLACE
11 S LST($$NXT)="~Outpt Place" D OUTPLACE
12 Q
13SRVC ; get list of consulting services
14 ; S NAM="" F S NAM=$O(^ORD(101.43,"S.CSLT",NAM)) Q:NAM="" D
15 ; . S IEN=$O(^ORD(101.43,"S.CSLT",NAM,0))
16 ; . S LST($$NXT)="i"_IEN_U_NAM
17 ; Q
18 N TMPLST,IEN,I
19 D GETLST^XPAR(.TMPLST,"ALL","ORWD CONSULT SERVICES")
20 S I=0 F S I=$O(TMPLST(I)) Q:'I D
21 . S IEN=$P(TMPLST(I),U,2)
22 . S LST($$NXT)="i"_IEN_U_$P(^ORD(101.43,IEN,0),U,1)
23 Q
24INURG ; get list of urgencies for inpatient consults
25 F X="STAT","ROUTINE","WITHIN 48 HOURS","WITHIN 72 HOURS" D
26 . S IEN=$O(^ORD(101.42,"B",X,0))
27 . S LST($$NXT)="i"_IEN_U_X
28 S LST($$NXT)="dROUTINE"
29 Q
30OUTURG ; get list of urgencies for outpatient consults
31 F X="STAT","TODAY","NEXT AVAILABLE","ROUTINE","WITHIN 72 HOURS","WITHIN 1 WEEK","WITHIN 1 MONTH" D
32 . S IEN=$O(^ORD(101.42,"B",X,0))
33 . S LST($$NXT)="i"_IEN_U_X
34 S LST($$NXT)="dROUTINE"
35 Q
36OUTPLACE ; load list of places
37 F X="C^Consultant's Choice","E^Emergency Room" S LST($$NXT)="i"_X
38 S LST($$NXT)="dConsultant's Choice"
39 Q
40INPLACE ; load list of places for outpatient
41 F X="B^Bedside","C^Consultant's Choice" S LST($$NXT)="i"_X
42 S LST($$NXT)="dBedside"
43 Q
44NXT() ; increments ILST
45 S ILST=ILST+1
46 Q ILST
47LOOK200(VAL,X) ; Lookup a person in 200
48 S VAL=$$FIND1^DIC(200,"","",X)
49 Q
Note: See TracBrowser for help on using the repository browser.