source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDCN32.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1ORWDCN32 ; SLC/KCM/REV - Consults calls [ 12/16/97 12:47 PM ] ;14:50 PM 01 MAR 2001
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85**;Dec 17, 1997
3 ;
4DEF(LST,WHY) ; load consult info
5 N ILST,NAM,IEN,X
6 S ILST=0
7 S LST($$NXT)="~ShortList" D SHORT
8 I WHY="C" D
9 . S LST($$NXT)="~Inpt Cslt Urgencies" D INCURG
10 I WHY="P" D
11 . S LST($$NXT)="~Inpt Proc Urgencies" D INPURG
12 S LST($$NXT)="~Outpt Urgencies" D OUTURG
13 S LST($$NXT)="~Inpt Place" D INPLACE
14 S LST($$NXT)="~Outpt Place" D OUTPLACE
15 Q
16SHORT ;return list of Consults or Procedures quick orders
17 N I,TMP
18 Q:"CP"'[WHY
19 S I=$O(^ORD(100.98,"B",$S(WHY="C":"CSLT",WHY="P":"PROC"),0))
20 D GETQLST^ORWDXQ(.TMP,I,"Q")
21 S I=0 F S I=$O(TMP(I)) Q:'I D
22 . S LST($$NXT)="i"_TMP(I)
23 Q
24OUTPLACE ; load list of places
25 N X
26 F X="C^CONSULTANT'S CHOICE^C","E^EMERGENCY ROOM^E" D
27 . S LST($$NXT)="i"_X
28 S LST($$NXT)="d"_"C^CONSULTANT'S CHOICE^C"
29 Q
30INPLACE ; load list of places for outpatient
31 N X
32 F X="B^BEDSIDE^B","C^CONSULTANT'S CHOICE^C" D
33 . S LST($$NXT)="i"_X
34 S LST($$NXT)="d"_"B^BEDSIDE^B"
35 Q
36INCURG ; get list of urgencies for inpatient consults
37 N IEN,GMRCURG,GMRCPRO,X
38 S GMRCURG="",GMRCPRO=""
39 F S GMRCURG=$O(^ORD(101.42,"S.GMRCT",GMRCURG)) Q:GMRCURG="" D
40 . S GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
41 . S LST($$NXT)="i"_$O(^ORD(101.42,"S.GMRCT",GMRCURG,0))_U_GMRCURG_U_GMRCPRO
42 S IEN=$O(^ORD(101.42,"B","ROUTINE",0)),GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - ROUTINE",0))
43 S LST($$NXT)="d"_IEN_U_"ROUTINE"_U_GMRCPRO
44 Q
45INPURG ; get list of urgencies for inpatient procedures
46 N IEN,GMRCURG,GMRCPRO,X
47 S GMRCURG="",GMRCPRO=""
48 F S GMRCURG=$O(^ORD(101.42,"S.GMRCR",GMRCURG)) Q:GMRCURG="" D
49 . S GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
50 . S LST($$NXT)="i"_$O(^ORD(101.42,"S.GMRCR",GMRCURG,0))_U_GMRCURG_U_GMRCPRO
51 S IEN=$O(^ORD(101.42,"B","ROUTINE",0)),GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - ROUTINE",0))
52 S LST($$NXT)="d"_IEN_U_"ROUTINE"_U_GMRCPRO
53 Q
54OUTURG ; get list of urgencies for outpatient consults/procedures
55 N IEN,GMRCURG,GMRCPRO,X
56 S GMRCURG="",GMRCPRO=""
57 F S GMRCURG=$O(^ORD(101.42,"S.GMRCO",GMRCURG)) Q:GMRCURG="" D
58 . S GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
59 . S LST($$NXT)="i"_$O(^ORD(101.42,"S.GMRCO",GMRCURG,0))_U_GMRCURG_U_GMRCPRO
60 S IEN=$O(^ORD(101.42,"B","ROUTINE",0)),GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - ROUTINE",0))
61 S LST($$NXT)="d"_IEN_U_"ROUTINE"_U_GMRCPRO
62 Q
63NXT() ; increments ILST
64 S ILST=ILST+1
65 Q ILST
66LOOK200(VAL,X) ; Lookup a person in 200
67 S VAL=$$FIND1^DIC(200,"","",X)
68 Q
69ORDRMSG(Y,ORDITM) ;returns order message for this consult/procedure orderable
70 N I
71 S I=0 F S I=$O(^ORD(101.43,ORDITM,8,I)) Q:I'>0 S Y(I)=^(I,0)
72 Q
73GETPROTO(Y,ORIEN) ;Get Protocol file IEN from OR IEN
74 S Y=$P($G(^ORD(101.43,ORIEN,0)),U,2)
75 Q
76GETOINUM(Y,ORNUM) ;Get Orderable Item IEN from Protocol IEN
77 S Y=$O(^ORD(101.43,"ID",ORNUM,0))
78 Q
79GETPRONM(Y,ORNAME) ;Get Protocol IEN given name
80 S Y=$O(^ORD(101,"B",ORNAME,0))_";99PRO"
81 Q
82PROC(Y,FROM,DIR) ; Return a subset of orderable procedures
83 ; .Return Array, Starting Text, Direction
84 ; ^ORD(101.43,"S.PROC",UpperCase,DA)=Mne^MixedCase^InactvDt^.01IfMne
85 ; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name
86 N I,IEN,CNT,X,DTXT,ORID,ORSVCCNT S I=0,CNT=44
87 F Q:I'<CNT S FROM=$O(^ORD(101.43,"S.PROC",FROM),DIR) Q:FROM="" D
88 . S IEN=0 F S IEN=$O(^ORD(101.43,"S.PROC",FROM,IEN)) Q:'IEN D
89 . . S X=^ORD(101.43,"S.PROC",FROM,IEN)
90 . . I +$P(X,U,3),$P(X,U,3)<$$NOW^XLFDT Q
91 . . S ORID=$P($G(^ORD(101.43,IEN,0)),U,2)
92 . . ;I $P($G(^ORD(101,ORIEN,0)),U,3)'="" Q ; Removed for v14
93 . . D GETSVC^GMRCPR0(.ORSVCCNT,ORID) Q:+ORSVCCNT=0
94 . . S I=I+1
95 . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2)_U_ORID
96 . . E S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4)_U_ORID
97 Q
98NEWDLG(Y,ORTYPE,ORLOC) ; Return order dialog info for New Consult OR PROCEDURE
99 N DGRP,ID,IEN,TXT,TYP,X,X0,X5,ENT
100 S ENT="ALL"
101 I $G(ORLOC) S ORLOC=+ORLOC_";SC(",ENT=ENT_"^"_ORLOC
102 I ORTYPE="C" S X=$$GET^XPAR(ENT,"ORWDX NEW CONSULT",1,"I")
103 E S X=$$GET^XPAR(ENT,"ORWDX NEW PROCEDURE",1,"I")
104 S IEN=+X,X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
105 S TYP=$P(X0,U,4),DGRP=+$P(X0,U,5),ID=+$P(X5,U,5),TXT=$P(X5,U,4)
106 S Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
107 Q
Note: See TracBrowser for help on using the repository browser.