ORWDCSLT ; SLC/KCM - Consults calls [ 08/04/96 7:36 PM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
;
DEF(LST) ; load consult info
N ILST,NAM,IEN,X
S ILST=0
S LST($$NXT)="~Services" D SRVC
S LST($$NXT)="~Inpt Urgencies" D INURG
S LST($$NXT)="~Outpt Urgencies" D OUTURG
S LST($$NXT)="~Inpt Place" D INPLACE
S LST($$NXT)="~Outpt Place" D OUTPLACE
Q
SRVC ; get list of consulting services
; S NAM="" F S NAM=$O(^ORD(101.43,"S.CSLT",NAM)) Q:NAM="" D
; . S IEN=$O(^ORD(101.43,"S.CSLT",NAM,0))
; . S LST($$NXT)="i"_IEN_U_NAM
; Q
N TMPLST,IEN,I
D GETLST^XPAR(.TMPLST,"ALL","ORWD CONSULT SERVICES")
S I=0 F S I=$O(TMPLST(I)) Q:'I D
. S IEN=$P(TMPLST(I),U,2)
. S LST($$NXT)="i"_IEN_U_$P(^ORD(101.43,IEN,0),U,1)
Q
INURG ; get list of urgencies for inpatient consults
F X="STAT","ROUTINE","WITHIN 48 HOURS","WITHIN 72 HOURS" D
. S IEN=$O(^ORD(101.42,"B",X,0))
. S LST($$NXT)="i"_IEN_U_X
S LST($$NXT)="dROUTINE"
Q
OUTURG ; get list of urgencies for outpatient consults
F X="STAT","TODAY","NEXT AVAILABLE","ROUTINE","WITHIN 72 HOURS","WITHIN 1 WEEK","WITHIN 1 MONTH" D
. S IEN=$O(^ORD(101.42,"B",X,0))
. S LST($$NXT)="i"_IEN_U_X
S LST($$NXT)="dROUTINE"
Q
OUTPLACE ; load list of places
F X="C^Consultant's Choice","E^Emergency Room" S LST($$NXT)="i"_X
S LST($$NXT)="dConsultant's Choice"
Q
INPLACE ; load list of places for outpatient
F X="B^Bedside","C^Consultant's Choice" S LST($$NXT)="i"_X
S LST($$NXT)="dBedside"
Q
NXT() ; increments ILST
S ILST=ILST+1
Q ILST
LOOK200(VAL,X) ; Lookup a person in 200
S VAL=$$FIND1^DIC(200,"","",X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDCSLT 1642 printed Dec 13, 2024@02:35:30 Page 2
ORWDCSLT ; SLC/KCM - Consults calls [ 08/04/96 7:36 PM ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
+2 ;
DEF(LST) ; load consult info
+1 NEW ILST,NAM,IEN,X
+2 SET ILST=0
+3 SET LST($$NXT)="~Services"
DO SRVC
+4 SET LST($$NXT)="~Inpt Urgencies"
DO INURG
+5 SET LST($$NXT)="~Outpt Urgencies"
DO OUTURG
+6 SET LST($$NXT)="~Inpt Place"
DO INPLACE
+7 SET LST($$NXT)="~Outpt Place"
DO OUTPLACE
+8 QUIT
SRVC ; get list of consulting services
+1 ; S NAM="" F S NAM=$O(^ORD(101.43,"S.CSLT",NAM)) Q:NAM="" D
+2 ; . S IEN=$O(^ORD(101.43,"S.CSLT",NAM,0))
+3 ; . S LST($$NXT)="i"_IEN_U_NAM
+4 ; Q
+5 NEW TMPLST,IEN,I
+6 DO GETLST^XPAR(.TMPLST,"ALL","ORWD CONSULT SERVICES")
+7 SET I=0
FOR
SET I=$ORDER(TMPLST(I))
if 'I
QUIT
Begin DoDot:1
+8 SET IEN=$PIECE(TMPLST(I),U,2)
+9 SET LST($$NXT)="i"_IEN_U_$P(^ORD(101.43,IEN,0),U,1)
End DoDot:1
+10 QUIT
INURG ; get list of urgencies for inpatient consults
+1 FOR X="STAT","ROUTINE","WITHIN 48 HOURS","WITHIN 72 HOURS"
Begin DoDot:1
+2 SET IEN=$ORDER(^ORD(101.42,"B",X,0))
+3 SET LST($$NXT)="i"_IEN_U_X
End DoDot:1
+4 SET LST($$NXT)="dROUTINE"
+5 QUIT
OUTURG ; get list of urgencies for outpatient consults
+1 FOR X="STAT","TODAY","NEXT AVAILABLE","ROUTINE","WITHIN 72 HOURS","WITHIN 1 WEEK","WITHIN 1 MONTH"
Begin DoDot:1
+2 SET IEN=$ORDER(^ORD(101.42,"B",X,0))
+3 SET LST($$NXT)="i"_IEN_U_X
End DoDot:1
+4 SET LST($$NXT)="dROUTINE"
+5 QUIT
OUTPLACE ; load list of places
+1 FOR X="C^Consultant's Choice","E^Emergency Room"
SET LST($$NXT)="i"_X
+2 SET LST($$NXT)="dConsultant's Choice"
+3 QUIT
INPLACE ; load list of places for outpatient
+1 FOR X="B^Bedside","C^Consultant's Choice"
SET LST($$NXT)="i"_X
+2 SET LST($$NXT)="dBedside"
+3 QUIT
NXT() ; increments ILST
+1 SET ILST=ILST+1
+2 QUIT ILST
LOOK200(VAL,X) ; Lookup a person in 200
+1 SET VAL=$$FIND1^DIC(200,"","",X)
+2 QUIT
