Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWDCN32

ORWDCN32.m

Go to the documentation of this file. 
  1. ORWDCN32 ; SLC/KCM/REV - Consults calls [ 12/16/97  12:47 PM ] ;14:50 PM 01 MAR 2001
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85**;Dec 17, 1997
  1.  ;
  1. DEF(LST,WHY)         ; load consult info    
  1.  N ILST,NAM,IEN,X
  1.  S ILST=0
  1.  S LST($$NXT)="~ShortList" D SHORT
  1.  I WHY="C" D
  1.  . S LST($$NXT)="~Inpt Cslt Urgencies" D INCURG
  1.  I WHY="P" D
  1.  . S LST($$NXT)="~Inpt Proc Urgencies" D INPURG
  1.  S LST($$NXT)="~Outpt Urgencies" D OUTURG
  1.  S LST($$NXT)="~Inpt Place" D INPLACE
  1.  S LST($$NXT)="~Outpt Place" D OUTPLACE
  1.  Q
  1. SHORT ;return list of Consults or Procedures quick orders
  1.  N I,TMP
  1.  Q:"CP"'[WHY
  1.  S I=$O(^ORD(100.98,"B",$S(WHY="C":"CSLT",WHY="P":"PROC"),0))
  1.  D GETQLST^ORWDXQ(.TMP,I,"Q")
  1.  S I=0 F  S I=$O(TMP(I)) Q:'I  D
  1.  . S LST($$NXT)="i"_TMP(I)
  1.  Q
  1. OUTPLACE ; load list of places
  1.  N X
  1.  F X="C^CONSULTANT'S CHOICE^C","E^EMERGENCY ROOM^E" D
  1.  . S LST($$NXT)="i"_X
  1.  S LST($$NXT)="d"_"C^CONSULTANT'S CHOICE^C"
  1.  Q
  1. INPLACE ; load list of places for outpatient
  1.  N X
  1.  F X="B^BEDSIDE^B","C^CONSULTANT'S CHOICE^C" D
  1.  . S LST($$NXT)="i"_X
  1.  S LST($$NXT)="d"_"B^BEDSIDE^B"
  1.  Q
  1. INCURG ; get list of urgencies for inpatient consults
  1.  N IEN,GMRCURG,GMRCPRO,X
  1.  S GMRCURG="",GMRCPRO=""
  1.  F  S GMRCURG=$O(^ORD(101.42,"S.GMRCT",GMRCURG)) Q:GMRCURG=""  D
  1.  . S GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
  1.  . S LST($$NXT)="i"_$O(^ORD(101.42,"S.GMRCT",GMRCURG,0))_U_GMRCURG_U_GMRCPRO
  1.  S IEN=$O(^ORD(101.42,"B","ROUTINE",0)),GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - ROUTINE",0))
  1.  S LST($$NXT)="d"_IEN_U_"ROUTINE"_U_GMRCPRO
  1.  Q
  1. INPURG ; get list of urgencies for inpatient procedures
  1.  N IEN,GMRCURG,GMRCPRO,X
  1.  S GMRCURG="",GMRCPRO=""
  1.  F  S GMRCURG=$O(^ORD(101.42,"S.GMRCR",GMRCURG)) Q:GMRCURG=""  D
  1.  . S GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
  1.  . S LST($$NXT)="i"_$O(^ORD(101.42,"S.GMRCR",GMRCURG,0))_U_GMRCURG_U_GMRCPRO
  1.  S IEN=$O(^ORD(101.42,"B","ROUTINE",0)),GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - ROUTINE",0))
  1.  S LST($$NXT)="d"_IEN_U_"ROUTINE"_U_GMRCPRO
  1.  Q
  1. OUTURG ; get list of urgencies for outpatient consults/procedures
  1.  N IEN,GMRCURG,GMRCPRO,X
  1.  S GMRCURG="",GMRCPRO=""
  1.  F  S GMRCURG=$O(^ORD(101.42,"S.GMRCO",GMRCURG)) Q:GMRCURG=""  D
  1.  . S GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
  1.  . S LST($$NXT)="i"_$O(^ORD(101.42,"S.GMRCO",GMRCURG,0))_U_GMRCURG_U_GMRCPRO
  1.  S IEN=$O(^ORD(101.42,"B","ROUTINE",0)),GMRCPRO=$O(^ORD(101,"B","GMRCURGENCY - ROUTINE",0))
  1.  S LST($$NXT)="d"_IEN_U_"ROUTINE"_U_GMRCPRO
  1.  Q
  1. NXT() ; increments ILST
  1.  S ILST=ILST+1
  1.  Q ILST
  1. LOOK200(VAL,X)     ; Lookup a person in 200
  1.  S VAL=$$FIND1^DIC(200,"","",X)
  1.  Q
  1. ORDRMSG(Y,ORDITM) ;returns order message for this consult/procedure orderable
  1.  N I
  1.  S I=0 F  S I=$O(^ORD(101.43,ORDITM,8,I)) Q:I'>0  S Y(I)=^(I,0)
  1.  Q
  1. GETPROTO(Y,ORIEN) ;Get Protocol file IEN from OR IEN
  1.  S Y=$P($G(^ORD(101.43,ORIEN,0)),U,2)
  1.  Q
  1. GETOINUM(Y,ORNUM) ;Get Orderable Item IEN from Protocol IEN
  1.  S Y=$O(^ORD(101.43,"ID",ORNUM,0))
  1.  Q
  1. GETPRONM(Y,ORNAME) ;Get Protocol IEN given name
  1.  S Y=$O(^ORD(101,"B",ORNAME,0))_";99PRO"
  1.  Q
  1. PROC(Y,FROM,DIR) ; Return a subset of orderable procedures
  1.  ; .Return Array, Starting Text, Direction
  1.  ; ^ORD(101.43,"S.PROC",UpperCase,DA)=Mne^MixedCase^InactvDt^.01IfMne
  1.  ; Y(n)=IEN^.01 Name^.01 Name  -or-  IEN^Synonym <.01 Name>^.01 Name
  1.  N I,IEN,CNT,X,DTXT,ORID,ORSVCCNT S I=0,CNT=44
  1.  F  Q:I'<CNT  S FROM=$O(^ORD(101.43,"S.PROC",FROM),DIR) Q:FROM=""  D
  1.  . S IEN=0 F  S IEN=$O(^ORD(101.43,"S.PROC",FROM,IEN)) Q:'IEN  D
  1.  . . S X=^ORD(101.43,"S.PROC",FROM,IEN)
  1.  . . I +$P(X,U,3),$P(X,U,3)<$$NOW^XLFDT Q
  1.  . . S ORID=$P($G(^ORD(101.43,IEN,0)),U,2)
  1.  . . ;I $P($G(^ORD(101,ORIEN,0)),U,3)'="" Q   ; Removed for v14
  1.  . . D GETSVC^GMRCPR0(.ORSVCCNT,ORID) Q:+ORSVCCNT=0
  1.  . . S I=I+1
  1.  . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2)_U_ORID
  1.  . . E  S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4)_U_ORID
  1.  Q
  1. NEWDLG(Y,ORTYPE,ORLOC) ; Return order dialog info for New Consult OR PROCEDURE
  1.  N DGRP,ID,IEN,TXT,TYP,X,X0,X5,ENT
  1.  S ENT="ALL"
  1.  I $G(ORLOC) S ORLOC=+ORLOC_";SC(",ENT=ENT_"^"_ORLOC
  1.  I ORTYPE="C" S X=$$GET^XPAR(ENT,"ORWDX NEW CONSULT",1,"I")
  1.  E  S X=$$GET^XPAR(ENT,"ORWDX NEW PROCEDURE",1,"I")
  1.  S IEN=+X,X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
  1.  S TYP=$P(X0,U,4),DGRP=+$P(X0,U,5),ID=+$P(X5,U,5),TXT=$P(X5,U,4)
  1.  S Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
  1.  Q