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