ORWDRA.m

ORWDRA ; SLC/KCM - Radiology calls to support windows [ 08/03/96  6:42 PM ]

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

 ;

DEF(LST,PATID) ; Get dialog data for radiology

 N ILST,I,X S ILST=0

 S LST($$NXT)="~Common Procedures" D COMMPRO

 S LST($$NXT)="~Modifiers" D MODIFYR

 S LST($$NXT)="~Urgencies" D URGENCY

 S LST($$NXT)="~Transport" D TRNSPRT

 S LST($$NXT)="~Category" D CATEGRY

 S LST($$NXT)="~Submit to" D SUBMIT

 S LST($$NXT)="~Ask Submit="_$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q")

 S LST($$NXT)="~Last 7 Days" D LAST7

 Q

MODIFYR ; Get the modifiers (should be by imaging type)

 S I=0 F  S I=$O(^RAMIS(71.2,I)) Q:'I  S LST($$NXT)="i"_I_U_$P(^(I,0),U)

 Q

COMMPRO ; Get the common procedures

 S X="" F  S X=$O(^ORD(101.43,"COMMON","RAD",X)) Q:X=""  D

 . S I=$O(^ORD(101.43,"COMMON","RAD",X,0)),LST($$NXT)="i"_I_U_X

 Q

URGENCY ; Get the allowable urgencies and default

 F X="STAT","ASAP","ROUTINE","DONE" D

 . S I=$O(^ORD(101.42,"B",X,0)),LST($$NXT)="i"_I_U_X

 S LST($$NXT)="dROUTINE"

 Q

TRNSPRT ; Get the modes of transport

 F X="A^AMBULATORY","P^PORTABLE","S^STRETCHER","W^WHEELCHAIR" D

 . S LST($$NXT)="i"_X

 ; figure default on windows side

 Q

CATEGRY ; Get the categories of exam  

 F X="I^INPATIENT","O^OUTPATIENT","C^CONTRACT","S^SHARING","E^EMPLOYEE","R^RESEARCH" D

 . S LST($$NXT)="i"_X

 ; figure default on windows side

 Q

SUBMIT ; Get the locations to which the request may be submitted

 N TMPLST

 D EN4^RAO7PC1("RAD","TMPLST")

 S I=0 F  S I=$O(TMPLST(I)) Q:'I  S LST($$NXT)="i"_TMPLST(I)

 S I=$O(TMPLST(0)),X=$P(TMPLST(I),U,2),LST($$NXT)="d"_X

 Q

LAST7 ; Get exams for the last 7 days

 K ^TMP($J,"RAE7") D EN2^RAO7PC1(PATID)

 S I=0 F  S I=$O(^TMP($J,"RAE7",PATID,I)) Q:'I  D 

 . S LST($$NXT)="i"_I_U_^(I)

 K ^TMP($J,"RAE7")

 Q

NXT() ; Increment index of LST

 S ILST=ILST+1

 Q ILST

ORWDRA    ; SLC/KCM - Radiology calls to support windows [ 08/03/96  6:42 PM ]

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

 +2       ;

DEF(LST,PATID) ; Get dialog data for radiology

 +1        NEW ILST,I,X

           SET ILST=0

 +2        SET LST($$NXT)="~Common Procedures"

           DO COMMPRO

 +3        SET LST($$NXT)="~Modifiers"

           DO MODIFYR

 +4        SET LST($$NXT)="~Urgencies"

           DO URGENCY

 +5        SET LST($$NXT)="~Transport"

           DO TRNSPRT

 +6        SET LST($$NXT)="~Category"

           DO CATEGRY

 +7        SET LST($$NXT)="~Submit to"

           DO SUBMIT

 +8        SET LST($$NXT)="~Ask Submit="_$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q")

 +9        SET LST($$NXT)="~Last 7 Days"

           DO LAST7

 +10       QUIT 

MODIFYR   ; Get the modifiers (should be by imaging type)

 +1        SET I=0

           FOR 

               SET I=$ORDER(^RAMIS(71.2,I))

               IF 'I

                   QUIT 

               SET LST($$NXT)="i"_I_U_$P(^(I,0),U)

 +2        QUIT 

COMMPRO   ; Get the common procedures

 +1        SET X=""

           FOR 

               SET X=$ORDER(^ORD(101.43,"COMMON","RAD",X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +2                SET I=$ORDER(^ORD(101.43,"COMMON","RAD",X,0))

                   SET LST($$NXT)="i"_I_U_X

               End DoDot:1

 +3        QUIT 

URGENCY   ; Get the allowable urgencies and default

 +1        FOR X="STAT","ASAP","ROUTINE","DONE"

               Begin DoDot:1

 +2                SET I=$ORDER(^ORD(101.42,"B",X,0))

                   SET LST($$NXT)="i"_I_U_X

               End DoDot:1

 +3        SET LST($$NXT)="dROUTINE"

 +4        QUIT 

TRNSPRT   ; Get the modes of transport

 +1        FOR X="A^AMBULATORY","P^PORTABLE","S^STRETCHER","W^WHEELCHAIR"

               Begin DoDot:1

 +2                SET LST($$NXT)="i"_X

               End DoDot:1

 +3       ; figure default on windows side

 +4        QUIT 

CATEGRY   ; Get the categories of exam  

 +1        FOR X="I^INPATIENT","O^OUTPATIENT","C^CONTRACT","S^SHARING","E^EMPLOYEE","R^RESEARCH"

               Begin DoDot:1

 +2                SET LST($$NXT)="i"_X

               End DoDot:1

 +3       ; figure default on windows side

 +4        QUIT 

SUBMIT    ; Get the locations to which the request may be submitted

 +1        NEW TMPLST

 +2        DO EN4^RAO7PC1("RAD","TMPLST")

 +3        SET I=0

           FOR 

               SET I=$ORDER(TMPLST(I))

               IF 'I

                   QUIT 

               SET LST($$NXT)="i"_TMPLST(I)

 +4        SET I=$ORDER(TMPLST(0))

           SET X=$PIECE(TMPLST(I),U,2)

           SET LST($$NXT)="d"_X

 +5        QUIT 

LAST7     ; Get exams for the last 7 days

 +1        KILL ^TMP($JOB,"RAE7")

           DO EN2^RAO7PC1(PATID)

 +2        SET I=0

           FOR 

               SET I=$ORDER(^TMP($JOB,"RAE7",PATID,I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +3                SET LST($$NXT)="i"_I_U_^(I)

               End DoDot:1

 +4        KILL ^TMP($JOB,"RAE7")

 +5        QUIT 

NXT()     ; Increment index of LST

 +1        SET ILST=ILST+1

 +2        QUIT ILST