ORWDCSLT.m

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

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