- 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 Feb 19, 2025@00:02:02 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