73 lines
2.9 KiB
Mathematica
73 lines
2.9 KiB
Mathematica
ORKRA ; slc/CLA - Order checking support procedure for Radiology ;12/15/97
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,92,105**;Dec 17, 1997
|
|
Q
|
|
RECENTBA(ORDFN,ORHRS) ; extrinsic function to return the most recent radiology procedure using barium within the past ORHRS in the format:
|
|
; order #^order text (first 60 chars) order effective date/time
|
|
N BDT,EDT,INBDT,XDT,X,ORDT,HDT,ORN,OROI,ORCM,TOT,ORQ,ORDG
|
|
S X="",ORDT="",HDT="",ORN="",TOT=0,ORQ=""
|
|
Q:+$G(ORDFN)<1 ORQ
|
|
Q:+$G(ORHRS)<1 ORQ
|
|
D NOW^%DTC S EDT=% K %
|
|
S BDT=$$FMADD^XLFDT(EDT,"","-"_ORHRS,"","")
|
|
Q:+$G(BDT)<1 ORQ
|
|
S ORDG=$$DG^ORQOR1("GENERAL RADIOLOGY")
|
|
Q:+$G(ORDG)<1 ORQ
|
|
K ^TMP("ORR",$J)
|
|
D EN^ORQ1(ORDFN_";DPT(",ORDG,1,"",BDT,EDT,0,0)
|
|
S HDT=$O(^TMP("ORR",$J,HDT)) Q:HDT="" ORQ S TOT=^(HDT,"TOT") I TOT>0 D
|
|
.F X=1:1:TOT Q:+$G(ORQ)>0 D ;quit on 1st barium found (most recent)
|
|
..S ORN=+^TMP("ORR",$J,HDT,X)
|
|
..S OROI=$G(^OR(100,ORN,.1,1,0))
|
|
..Q:+$G(OROI)<1
|
|
..S ORCM=$$CM^ORQQRA(OROI)
|
|
..I $G(ORCM)["B" D
|
|
...S ORDT=$G(^OR(100,ORN,0)) S:$L($G(ORDT)) ORDT=$P(ORDT,U,8)
|
|
...S ORDT=$$FMTE^XLFDT(ORDT,"2P")
|
|
...S ORQ=ORN_U_$P($$TEXT^ORKOR(ORN,60),U,2)_" "_$G(ORDT)
|
|
K ^TMP("ORR",$J)
|
|
Q ORQ
|
|
RECENTCH(ORDFN,ORDAYS) ;extrinsic function to return the most recent cholecystogram procedure within the past ORDAYS in the format:
|
|
; order #^order text (first 60 chars) order effective date/time
|
|
N BDT,EDT,INBDT,XDT,X,ORDT,HDT,ORN,OROI,ORCM,TOT,ORQ,ORDG
|
|
S X="",ORDT="",HDT="",ORN="",TOT=0,ORQ=""
|
|
Q:+$G(ORDFN)<1 ORQ
|
|
Q:+$G(ORDAYS)<1 ORQ
|
|
D NOW^%DTC S EDT=% K %
|
|
S BDT=$$FMADD^XLFDT(EDT,"-"_ORDAYS,"","","")
|
|
Q:+$G(BDT)<1 ORQ
|
|
S ORDG=$$DG^ORQOR1("GENERAL RADIOLOGY")
|
|
Q:+$G(ORDG)<1 ORQ
|
|
K ^TMP("ORR",$J)
|
|
D EN^ORQ1(ORDFN_";DPT(",ORDG,1,"",BDT,EDT,0,0)
|
|
S HDT=$O(^TMP("ORR",$J,HDT)) Q:HDT="" ORQ S TOT=^(HDT,"TOT") I TOT>0 D
|
|
.F X=1:1:TOT Q:+$G(ORQ)>0 D ;quit on 1st cholecyst found (most recent)
|
|
..S ORN=+^TMP("ORR",$J,HDT,X)
|
|
..S OROI=$G(^OR(100,ORN,.1,1,0))
|
|
..Q:+$G(OROI)<1
|
|
..S ORCM=$$CM^ORQQRA(OROI)
|
|
..I $G(ORCM)["C" D ;cholecystogram
|
|
...S ORDT=$G(^OR(100,ORN,0)) S:$L($G(ORDT)) ORDT=$P(ORDT,U,8)
|
|
...S ORDT=$$FMTE^XLFDT(ORDT,"2P")
|
|
...S ORQ=ORN_U_$P($$TEXT^ORKOR(ORN,60),U,2)_" "_$G(ORDT)
|
|
K ^TMP("ORR",$J)
|
|
Q ORQ
|
|
TYPE(OI) ;extrinisic function which returns the imaging type for an orderable item
|
|
;returned as 'RAD','CT','MRI','ANI','CARD','NM','US', or 'VAS'
|
|
N ORTYPE S ORTYPE=""
|
|
S ORTYPE=$G(^ORD(101.43,OI,"RA"))
|
|
S:$L($G(ORTYPE)) ORTYPE=$P(ORTYPE,U,3)
|
|
Q ORTYPE
|
|
CMCDAYS(DFN) ;extrinsic function to return number of days to look for
|
|
; contrast media serum creatinine result
|
|
Q:'$L(DFN) ""
|
|
N ORLOC,ORENT,ORDAYS
|
|
;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
|
|
;reliably determined, and many simultaneous outpt locations can occur):
|
|
S VA200="" D OERR^VADPT
|
|
S ORLOC=+$G(^DIC(42,+VAIN(4),44))
|
|
K VA200,VAIN
|
|
S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
|
|
S ORDAYS=$$GET^XPAR(ORENT,"ORK CONTRAST MEDIA CREATININE",1,"I")
|
|
Q:$L(ORDAYS) ORDAYS
|
|
Q ""
|