- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDRA 1857 printed Feb 19, 2025@00:02:19 Page 2
- 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