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 Oct 16, 2024@18:36:21 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
